74e2f4b8439ba2ccd0f040aec0ba8d7c1fe75695
[mes.git] / configure
1 #! /bin/sh
2 # -*- scheme -*-
3 unset LANG LC_ALL
4 guile=$(command -v ${GUILE-guile})
5 if $(command -v ${GUIX-guix}); then
6     install="guix environment -l guix.scm"
7 else
8     install="sudo apt-get install guile-2.2-dev"
9 fi
10 if [ -z "$guile" ]; then
11     cat <<EOF
12
13 Missing dependencies: ${GUILE-guile}, please install Guile 2.2 or later; run
14     $install
15 EOF
16 exit 1
17 fi
18 GUILE=$guile
19 export GUILE
20 exec ${guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
21 !#
22
23 ;;; Mes --- Maxwell Equations of Software
24 ;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
25 ;;;
26 ;;; configure: This file is part of Mes.
27 ;;;
28 ;;; Mes is free software; you can redistribute it and/or modify it
29 ;;; under the terms of the GNU General Public License as published by
30 ;;; the Free Software Foundation; either version 3 of the License, or (at
31 ;;; your option) any later version.
32 ;;;
33 ;;; Mes is distributed in the hope that it will be useful, but
34 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
35 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
36 ;;; GNU General Public License for more details.
37 ;;;
38 ;;; You should have received a copy of the GNU General Public License
39 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
40
41 (define-module (configure)
42   #:use-module (srfi srfi-1)
43   #:use-module (srfi srfi-9)
44   #:use-module (srfi srfi-9 gnu)
45   #:use-module (srfi srfi-26)
46   #:use-module (ice-9 and-let-star)
47   #:use-module (ice-9 curried-definitions)
48   #:use-module (ice-9 getopt-long)
49   #:use-module (ice-9 match)
50   #:use-module (ice-9 optargs)
51   #:use-module (ice-9 popen)
52   #:use-module (ice-9 rdelim)
53   #:use-module (ice-9 regex)
54   #:export (main))
55
56 (define* (PATH-search-path name #:key (default name) warn?)
57   (or (search-path (string-split (getenv "PATH") #\:) name)
58       (and (and warn? (format (current-error-port) "warning: not found: ~a\n" name))
59            default)))
60
61 (define *shell* "sh")
62 (define PACKAGE "mes")
63 (define VERSION "0.16.1")
64
65 ;;; Utility
66 (define (logf port string . rest)
67   (apply format (cons* port string rest))
68   (force-output port)
69   #t)
70
71 (define (stderr string . rest)
72   (apply logf (cons* (current-error-port) string rest)))
73
74 (define (stdout string . rest)
75   (apply logf (cons* (current-output-port) string rest)))
76
77 (define %verbose? #f)
78
79 (define (verbose string . rest)
80   (if %verbose? (apply stderr (cons string rest))))
81
82 (define (gulp-pipe command)
83   (let* ((port (open-pipe* OPEN_READ *shell* "-c" command))
84          (output (read-string port))
85          (status (close-pipe port)))
86     (verbose "command[~a]: ~s => ~a\n" status command output)
87     (if (not (zero? status)) "" (string-trim-right output #\newline))))
88
89 (define* ((->string #:optional (infix "")) h . t)
90   (let ((o (if (pair? t) (cons h t) h)))
91     (match o
92       ((? char?) (make-string 1 o))
93       ((? number?) (number->string o))
94       ((? string?) o)
95       ((? symbol?) (symbol->string o))
96       ((h ... t) (string-join (map (->string) o) ((->string) infix)))
97       (_ ""))))
98
99 (define (tuple< a b)
100   (cond
101    ((and (null? a) (null? b)) #t)
102    ((null? a) (not (null? b)))
103    ((null? b) #f)
104    ((and (not (< (car a) (car b)))
105          (not (< (car b) (car a))))
106     (tuple< (cdr a) (cdr b)))
107    (else (< (car a) (car b)))))
108
109 (define (tuple<= a b)
110   (or (equal? a b) (tuple< a b)))
111
112 (define (conjoin . predicates)
113   (lambda (. arguments)
114     (every (cut apply <> arguments) predicates)))
115
116 (define (char->char from to char)
117   (if (eq? char from) to char))
118
119 (define (string-replace-char string from to)
120   (string-map (cut char->char from to <>) string))
121
122 ;;; Configure
123
124 (define-immutable-record-type <dependency>
125   (make-depedency name version-expected optional? version-option commands file-name)
126   dependency?
127   (name dependency-name)
128   (version-expected dependency-version-expected)
129   (version-option dependency-version-option)
130   (optional? dependency-optional?)
131   (commands dependency-commands)
132   (file-name dependency-file-name)
133   (version-found dependency-version-found))
134
135 (define* (make-dep name #:optional (version '(0))
136                    #:key optional? (version-option "--version") (commands (list name)) file-name)
137   (make-depedency name version optional? version-option commands file-name))
138
139 (define (find-dep name deps)
140   (find (compose (cut equal? <> name) dependency-name) deps))
141
142 (define (file-name name deps)
143   (and=> (find-dep name deps) dependency-file-name))
144
145 (define (variable-name dependency)
146   (and=>
147    (dependency-name dependency)
148    (compose string-upcase (cut string-replace-char <> #\- #\_))))
149
150 (define (version->string version)
151   ((->string '.) version))
152
153 (define (string->version string)
154   (and-let* ((version (string-tokenize string
155                                        (char-set-adjoin char-set:digit #\.)))
156              ((pair? version))
157              (version (sort version (lambda (a b) (> (string-length a) (string-length b)))))
158              (version (car version))
159              (version (string-tokenize version
160                                        (char-set-complement (char-set #\.)))))
161             (map string->number version)))
162
163 (define (check-program-version dependency)
164   (let ((name (dependency-name dependency))
165         (expected (dependency-version-expected dependency))
166         (version-option (dependency-version-option dependency))
167         (commands (dependency-commands dependency)))
168     (let loop ((commands commands))
169       (if (null? commands) dependency
170           (let ((command (car commands)))
171             (stdout "checking for ~a~a... " command
172                     (if (null? expected) ""
173                         (format #f " [~a]" (version->string expected))))
174             (let* ((output (gulp-pipe (format #f "~a ~a 2>&1" command version-option)))
175                    (actual (string->version output))
176                    (pass? (and actual (tuple< expected actual)))
177                    (dependency (set-field dependency (dependency-version-found) actual)))
178               (stdout "~a ~a\n" (if pass? (if (pair? actual) "" " yes")
179                                     (if actual " no, found" "no")) (version->string actual))
180               (if pass? (let ((file-name (or (PATH-search-path command)
181                                              (dependency-file-name dependency))))
182                           (set-field dependency (dependency-file-name) file-name))
183                   (loop (cdr commands)))))))))
184
185 (define (check-file dependency)
186   (stdout "checking for ~a... " (dependency-name dependency))
187   (let ((file-name (and (file-exists? (dependency-file-name dependency))
188                         (dependency-file-name dependency))))
189     (stdout "~a\n" (or file-name ""))
190     (set-field dependency (dependency-file-name) file-name)))
191
192 (define* (check-header-c dependency  #:optional (check check-compile-header-c))
193   (let ((name (dependency-name dependency)))
194     (stderr "checking for ~a..." name)
195     (let ((result (check name)))
196       (stderr " ~a\n" (if result "yes" "no"))
197       (if result (set-field dependency (dependency-file-name) name)
198           dependency-file-name))))
199
200 (define (check-compile-header-c header)
201   (zero? (system (format #f "echo '#include ~s' | gcc -E - > /dev/null 2>&1" header))))
202
203 (define (parse-opts args)
204   (let* ((option-spec
205           '((build (value #t))
206             (host (value #t))
207             (help (single-char #\h))
208             (prefix (value #t))
209             (sysconfdir (value #t))
210             (verbose (single-char #\v))
211             (with-courage)
212             (infodir (value #t))
213             (mandir (value #t))
214             (disable-silent-rules)
215
216             (enable-fast-install)       ; Ignored for Guix
217             (includedir (value #t))     ; Ignored for Debian
218             (mandir (value #t))         ; Ignored for Debian
219             (localstatedir (value #t))  ; Ignored for Debian
220             (libdir (value #t))         ; Ignored for Debian
221             (libexecdir (value #t))     ; Ignored for Debian
222             (runstatedir (value #t))    ; Ignored for Debian
223             (disable-maintainer-mode)   ; Ignored for Debian
224             (disable-dependency-tracking) ; Ignored for Debian
225             )))
226
227     (getopt-long args option-spec)))
228
229 (define* (print-help #:optional (port (current-output-port)))
230   (format port "\
231 `configure' configures ~a ~a to adapt to many kinds of systems.
232
233 Usage: ./configure [OPTION]... [VAR=VALUE]
234
235 To assign environment variables (e.g., CC, CFLAGS...), specify them as
236 VAR=VALUE.  See below for descriptions of some of the useful variables.
237
238 Defaults for the options are specified in brackets.
239
240 Options:
241   -h, --help           display this help
242       --build=BUILD    configure for building on BUILD [guessed]
243       --disable-silent-rules
244                        verbose build output [BUILD_DEBUG=1]
245       --host=HOST      cross-compile to build programs to run on HOST [BUILD]
246   -v, --verbose        be verbose
247   --with-courage       assert being courageous to configure for unsupported platform
248
249 Installation directories:
250   --prefix=DIR         install in prefix DIR [~a]
251   --infodir=DIR        info documentation [PREFIX/share/info]
252   --mandir=DIR         man pages [PREFIX/share/man]
253
254 Ignored for Guix:
255   --enable-fast-install
256
257 Ignored for Debian:
258   --disable-dependency-tracking
259   --disable-maintainer-mode
260   --includedir=DIR
261   --libdir=DIR
262   --libexecdir=DIR
263   --localstatedir=DIR
264   --mandir=DIR
265   --runstatedir=DIR
266
267 Some influential environment variables:
268   CC                C compiler command
269   CFLAGS            C compiler flags
270   CC32              x86 C compiler command
271   CC32_CFLAGS       x86 C compiler flags
272   GUILE             guile command
273   GUILE_TOOLS       guile-tools command
274   MES_CFLAGS        MesCC flags
275   MES_SEED          location of mes-seed
276   MESCC_TOOLS_SEED  location of mescc-tools-seed
277   TCC               tcc C compiler command
278   TINYCC_SEED       location of tinycc-seed
279 " PACKAGE VERSION (getenv "prefix")))
280
281 (define* (substitute file-name pairs
282                      #:key (target (if (string-suffix? ".in" file-name)
283                                        (string-drop-right file-name 3) target)))
284   (with-output-to-file target
285     (lambda _
286       (display
287        (fold (lambda (o result)
288                (regexp-substitute/global #f (car o) result 'pre (cdr o) 'post))
289              (with-input-from-file file-name read-string) pairs)))))
290
291 (define (main args)
292   (let* ((prefix "/usr/local")
293          (infodir "${prefix}/share/info")
294          (mandir "${prefix}/share/man")
295          (sysconfdir "${prefix}/etc")
296
297          (srcdir (dirname (car (command-line))))
298          (abs-top-srcdir (canonicalize-path srcdir))
299          (builddir (getcwd))
300          (abs-top-builddir (canonicalize-path builddir))
301
302
303          (options (parse-opts args))
304
305          (build-type (option-ref options 'build %host-type))
306          (arch (car (string-split build-type #\-)))
307          (host-type (option-ref options 'host %host-type))
308
309          (prefix (option-ref options 'prefix prefix))
310          (infodir (option-ref options 'infodir infodir))
311          (sysconfdir (option-ref options 'sysconfdir sysconfdir))
312          (datadir (string-append prefix "/share/mes"))
313          (moduledir (string-append datadir "/module"))
314          (guile-effective-version (effective-version))
315          (guile-site-dir (if (equal? prefix ".") (canonicalize-path ".")
316                              (string-append prefix "/share/guile/site/" guile-effective-version)))
317          (guile-site-ccache-dir (if (equal? prefix ".") (canonicalize-path ".")
318                                     (string-append prefix "/lib/guile/" guile-effective-version "/site-ccache")))
319          (with-courage? (option-ref options 'with-courage #f))
320          (disable-silent-rules? (option-ref options 'disable-silent-rules #f))
321          (vars (filter (cut string-index <> #\=) (option-ref options '() '())))
322          (help? (option-ref options 'help #f)))
323     (when help?
324       (print-help)
325       (exit 0))
326     (set! %verbose? (option-ref options 'verbose #f))
327     (for-each (lambda (v) (apply setenv (string-split v #\=))) vars)
328     (let* ((mes-seed (or (getenv "MES_SEED") "../mes-seed"))
329            (tinycc-seed (or (getenv "TINYCC_SEED") "../tinycc-seed"))
330            (mescc-tools-seed (or (getenv "MESCC_TOOLS_SEED") "../mescc-tools-seed"))
331            (deps (fold (lambda (program results)
332                          (cons (check-program-version program) results))
333                        '()
334                        (list (make-dep "guile" '(2 0) #:commands '("guile-2.2" "guile-2.0" "guile-2" "guile"))
335                              (make-dep "bash" '(2 0) #:optional? #t)
336                              (make-dep "guile-tools" '(2 0))
337                              (make-dep "mes-seed" '(0 16 1) #:optional? #t
338                                        #:commands (list (string-append mes-seed "/refresh.sh"))
339                                        #:file-name mes-seed)
340                              (make-dep "tinycc-seed" '(0 16) #:optional? #t
341                                        #:commands (list (string-append tinycc-seed "/refresh.sh"))
342                                        #:file-name tinycc-seed)
343                              (make-dep "cc" '(2 95) #:commands '("gcc"))
344                              (make-dep "make" '(4))
345                              (make-dep "cc32" '(2 95)
346                                        #:optional? #t
347                                        #:commands '("i686-unknown-linux-gnu-gcc"))
348                              (make-dep "M1" '(0 3))
349                              (make-dep "blood-elf" '(0 1))
350                              (make-dep "hex2" '(0 3))
351                              (make-dep "tcc" '(0 9 26) #:optional? #t)
352                              (make-dep "makeinfo" '(5) #:optional? #t)
353                              (make-dep "help2man" '(1 47) #:optional? #t)
354                              (make-dep "perl" '(5) #:optional? #t)
355                              (make-dep "git" '(2) #:optional? #t))))
356            (deps (cons (check-program-version (make-dep "nyacc" '(0 80 41) #:commands (list (string-append (file-name "guile" deps) " -c '(use-modules (nyacc lalr)) (display *nyacc-version*)'")) #:file-name #t))
357                        deps))
358            (deps (if (file-name "cc" deps)
359                      (cons* (check-header-c (make-dep "stdio.h"))
360                             (check-header-c (make-dep "limits.h"))
361                             deps)
362                      deps))
363            (deps (cons (check-file (make-dep "mescc-tools-seed" '(0) #:optional? #t
364                                              #:file-name mescc-tools-seed))
365                        deps))
366            (missing (filter (conjoin (negate dependency-file-name)
367                                      (negate dependency-optional?)) deps)))
368       (when (and (not (member arch '("i686" "x86_64"))) (not with-courage?))
369         (stderr "platform not supported: ~a, try --with-courage\n" arch)
370         (exit 1))
371       (when (pair? missing)
372         (stderr "\nMissing dependencies: ~a\n" (string-join (map dependency-name missing)))
373         (exit 1))
374       (let ((git (find-dep "git" deps)))
375         (when (and git
376                    (not (file-exists? ".git")))
377           ;; Debian wants to run `make clean' from a tarball
378           (and (zero? (system* "git" "init"))
379                (zero? (system* "git" "add" "."))
380                (zero? (system* "git" "commit" "-m" "Import mes")))))
381       (with-output-to-file ".config.make"
382         (lambda _
383           (stdout "PACKAGE:=~a\n" PACKAGE)
384           (stdout "VERSION:=~a\n" VERSION)
385
386           (stdout "build:=~a\n" build-type)
387           (stdout "host:=~a\n" host-type)
388           (stdout "srcdir:=.\n")
389           (stdout "prefix:=~a\n" (gulp-pipe (string-append "echo " prefix)))
390           (stdout "infodir:=~a\n" infodir)
391           (stdout "mandir:=~a\n" mandir)
392           (stdout "datadir:=~a\n" datadir)
393           (stdout "moduledir:=~a\n" moduledir)
394           (stdout "sysconfdir:=~a\n" sysconfdir)
395
396           (stdout "build:=~a\n" build-type)
397           (stdout "ARCH:=~a\n" arch)
398           (stdout "host:=~a\n" %host-type)
399           (stdout "build:=~a\n" build-type)
400
401           (for-each (lambda (o)
402                       (stdout "~a:=~a\n" (variable-name o) (or (dependency-file-name o) "")))
403                     deps)
404           (stdout "GUILE_EFFECTIVE_VERSION:=~a\n" (effective-version))
405
406           (when disable-silent-rules?
407             (stdout "BUILD_DEBUG:=1\n"))
408
409           (for-each (lambda (o)
410                       (stdout "~a:=~a\n" o (or (getenv o) "")))
411                     '(
412                       "CFLAGS"
413                       "CC32_CFLAGS"
414                       "HEX2FLAGS"
415                       "M1FLAGS"
416                       "CC32_CFLAGS"
417                       "MES_CFLAGS"
418                       ))))
419
420       (let ((pairs `(("@abs_top_srcdir@" . ,abs-top-srcdir)
421                      ("@abs_top_builddir@" . ,abs-top-builddir)
422                      ("@BASH@" . ,(file-name "bash" deps))
423                      ("@GUILE@" . ,(file-name "guile" deps))
424                      ("@guile_site_dir@" . ,guile-site-dir)
425                      ("@guile_site_ccache_dir@" . ,guile-site-ccache-dir)
426                      ("@VERSION@" . ,VERSION)
427                      ("mes/module/" . ,(string-append moduledir "/")))))
428         (for-each (lambda (o)
429                     (substitute o pairs)
430                     (chmod (string-drop-right o 3) #o755))
431                   '(
432                     "build-aux/pre-inst-env.in"
433                     "mes/module/mes/boot-0.scm.in"
434                     "scripts/mescc.in"
435                     )))
436       (chmod "build-aux/pre-inst-env" #o755)
437       (rename-file "build-aux/pre-inst-env" "pre-inst-env")
438       (chmod "scripts/mescc" #o755)
439       (let ((make (and=> (file-name "make" deps) basename)))
440         (format (current-output-port)
441                "\nRun:
442   ~a            to build mes
443   ~a help       for help on other targets\n"
444                (or make "./build.sh")
445                (or make "./build.sh"))))))