#! /bin/sh # -*-scheme-*- MES_ARENA=100000000 exec ${SCHEME-guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"} !# ;;; GNU Mes --- Maxwell Equations of Software ;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen ;;; ;;; configure: This file is part of GNU Mes. ;;; ;;; GNU Mes is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Mes is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Mes. If not, see . (define-module (configure) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-26) #:use-module (ice-9 getopt-long) #:use-module (ice-9 optargs) #:use-module (ice-9 popen) #:use-module (ice-9 rdelim) #:export (main)) (cond-expand (guile) (mes (mes-use-module (srfi srfi-1)) (mes-use-module (srfi srfi-9)) (mes-use-module (srfi srfi-9 gnu)) (mes-use-module (srfi srfi-26)) (mes-use-module (mes getopt-long)) (mes-use-module (mes guile)) (mes-use-module (mes misc)) (mes-use-module (mes optargs)) (define %host-type "x86_64-unknown-linux-gnu") (define OPEN_READ "r") (define (canonicalize-path o) (if (string-prefix? "/" o) o (string-append (getcwd) "/" o))) (define (sort lst less) lst) (define (close-pipe o) 0) (define (open-pipe* OPEN_READ . commands) (let ((fake-pipe ".pipe")) (with-output-to-file fake-pipe (lambda _ (let ((status (apply system* (append commands)))) (set! close-pipe (lambda _ status))))) (open-input-file fake-pipe))))) (define* (PATH-search-path name #:key (default name) warn?) (or (search-path (string-split (getenv "PATH") #\:) name) (and (and warn? (format (current-error-port) "warning: not found: ~a\n" name)) default))) (define *shell* "sh") (define PACKAGE "mes") (define VERSION "0.19") ;;; Utility (define (logf port string . rest) (apply format (cons* port string rest)) (force-output port) #t) (define (stderr string . rest) (apply logf (cons* (current-error-port) string rest))) (define (stdout string . rest) (apply logf (cons* (current-output-port) string rest))) (define %verbose? #f) (define (verbose string . rest) (if %verbose? (apply stderr (cons string rest)))) (define (gulp-pipe* . command) (let* ((err (current-error-port)) (foo (set-current-error-port (open-output-file ".error"))) (port (apply open-pipe* OPEN_READ command)) (output (read-string port)) (status (close-pipe port)) (error (with-input-from-file ".error" read-string))) (set-current-error-port err) (verbose "command[~a]: ~s => ~a [~a]\n" status command output error) (if (not (zero? status)) "" (string-trim-right (string-append output error))))) (define (tuple< a b) (cond ((and (null? a) (null? b)) #t) ((null? a) (not (null? b))) ((null? b) #f) ((and (not (< (car a) (car b))) (not (< (car b) (car a)))) (tuple< (cdr a) (cdr b))) (else (< (car a) (car b))))) (define (tuple<= a b) (or (equal? a b) (tuple< a b))) (define (conjoin . predicates) (lambda (. arguments) (every (cut apply <> arguments) predicates))) (define (char->char from to char) (if (eq? char from) to char)) (define (string-replace-char string from to) (string-map (cut char->char from to <>) string)) (define (string-replace-string string from to) (cond ((string-contains string from) => (lambda (i) (string-replace string to i (+ i (string-length from))))) (else string))) (define (string-replace-string/all string from to) (or (and=> (string-contains string from) (lambda (i) (string-append (substring string 0 i) to (string-replace-string/all (substring string (+ i (string-length from))) from to)))) string)) ;;; Configure (define-immutable-record-type (make-dependency name version-expected optional? version-option commands file-name data version-found) dependency? (name dependency-name) (version-expected dependency-version-expected) (optional? dependency-optional?) (version-option dependency-version-option) (commands dependency-commands) (file-name dependency-file-name) (data dependency-data) (version-found dependency-version-found)) (define* (make-dep name #:key (version '(0)) optional? (version-option "--version") (commands (list name)) file-name data) (let* ((env-var (getenv (name->shell-name name))) (commands (if env-var (cons env-var commands) commands))) (make-dependency name version optional? version-option commands file-name data #f))) (define (find-dep name deps) (find (compose (cut equal? <> name) dependency-name) deps)) (define (file-name name deps) (and=> (find-dep name deps) dependency-file-name)) (define (variable-name dependency) (and=> (dependency-name dependency) name->shell-name)) (define (name->shell-name name) (string-upcase (string-replace-char name #\- #\_))) (define (->string o) (cond ((number? o) (number->string o)) ((string? o) o) (else (format #f "~a" o)))) (define (version->string version) (and version (string-join (map ->string version) "."))) (define (string->version string) (let ((split (string-tokenize string (char-set-adjoin char-set:digit #\.)))) (and (pair? split) (let* ((version (sort split (lambda (a b) (> (string-length a) (string-length b))))) (version (car version)) (version (string-tokenize version (char-set-complement (char-set #\.))))) (map string->number version))))) (define (check-program-version dependency) (let ((name (dependency-name dependency)) (expected (dependency-version-expected dependency)) (version-option (dependency-version-option dependency)) (commands (dependency-commands dependency))) (let loop ((commands commands)) (if (null? commands) dependency (let ((command (car commands))) (stdout "checking for ~a~a... " name (if (null? expected) "" (format #f " [~a]" (version->string expected)))) (let* ((output (gulp-pipe* command version-option)) ;;(foo (stderr "output=~s\n" output)) (actual (string->version output)) ;;(foo (stderr "actual=~s\n" actual)) ;;(foo (stderr "expected=~s\n" expected)) (pass? (and actual (tuple< expected actual))) ;;(foo (stderr "PASS?~s\n" pass?)) (dependency (set-field dependency (dependency-version-found) actual))) (stdout "~a ~a\n" (if pass? (if (pair? actual) "" " yes") (if actual " no, found" "no")) (or (version->string actual) "")) (if pass? (let ((file-name (or (PATH-search-path command) (dependency-file-name dependency)))) (set-field dependency (dependency-file-name) file-name)) (loop (cdr commands))))))))) (define (check-file dependency) (stdout "checking for ~a... " (dependency-name dependency)) (let ((file-name (and (file-exists? (dependency-file-name dependency)) (dependency-file-name dependency)))) (stdout "~a\n" (or file-name "")) (set-field dependency (dependency-file-name) file-name))) (define* (check-header-c cc dependency #:optional (check check-preprocess-header-c)) (let ((name (dependency-name dependency))) (stderr "checking for ~a..." name) (let ((result (check cc name))) (stderr " ~a\n" (if result "yes" "no")) (if result (set-field dependency (dependency-file-name) name) dependency)))) (define* (check-compile-c cc dependency #:optional (check check-compile-string-c)) (let ((name (dependency-name dependency))) (stderr "checking for ~a..." name) (let ((result (check cc (dependency-data dependency)))) (stderr " ~a\n" (if result "yes" "no")) (if result (set-field dependency (dependency-file-name) name) dependency)))) (define* (check-link-c cc dependency #:optional (check check-link-string-c)) (let ((name (dependency-name dependency))) (stderr "checking for ~a..." name) (let ((result (check cc (dependency-data dependency)))) (stderr " ~a\n" (if result "yes" "no")) (if result (set-field dependency (dependency-file-name) name) dependency)))) (define (check-preprocess-header-c cc header) (with-output-to-file ".config.c" (cut format #t "#include \"~a\"" header)) (with-error-to-file "/dev/null" (cut zero? (system* cc "-E" "-o" ".config.E" ".config.c")))) (define (check-compile-string-c cc string) (with-output-to-file ".config.c" (cut display string)) (with-error-to-file "/dev/null" (cut zero? (system* cc "--std=gnu99" "-c" "-o" ".config.o" ".config.c")))) (define (check-link-string-c cc string) (with-output-to-file ".config.c" (cut display string)) (with-error-to-file "/dev/null" (cut zero? (system* cc "--std=gnu99" "-o" ".config" ".config.c")))) (define (parse-opts args) (let* ((option-spec '((build (value #t)) (host (value #t)) (prefix (value #t)) (program-prefix (value #t)) (bindir (value #t)) (datadir (value #t)) (docdir (value #t)) (libdir (value #t)) (srcdir (value #t)) (sysconfdir (value #t)) (mes) (help (single-char #\h)) (verbose (single-char #\v)) (with-cheating) (with-courage) (infodir (value #t)) (mandir (value #t)) (disable-silent-rules) (enable-silent-rules) (enable-fast-install) ; Ignored for Guix (includedir (value #t)) ; Ignored for Debian (mandir (value #t)) ; Ignored for Debian (localstatedir (value #t)) ; Ignored for Debian (libdir (value #t)) ; Ignored for Debian (libexecdir (value #t)) ; Ignored for Debian (runstatedir (value #t)) ; Ignored for Debian (disable-maintainer-mode) ; Ignored for Debian (disable-dependency-tracking) ; Ignored for Debian ))) (getopt-long args option-spec))) (define* (print-help #:optional (port (current-output-port))) (format port "\ `configure' configures ~a ~a to adapt to many kinds of systems. Usage: ./configure [OPTION]... [VAR=VALUE] To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Options: -h, --help display this help --build=BUILD configure for building on BUILD [guessed] --disable-silent-rules verbose build output [V=1] --host=HOST cross-compile to build programs to run on HOST [BUILD] --mes use Mes C Library -v, --verbose be verbose --with-courage assert being courageous to configure for unsupported platform --with-cheating cheat using Guile instead of Mes Installation directories: --prefix=DIR install in prefix DIR [~a] --infodir=DIR info documentation [PREFIX/share/info] --mandir=DIR man pages [PREFIX/share/man] Program names: --program-prefix=PREFIX prepend PREFIX to installed program names --program-suffix=SUFFIX append SUFFIX to installed program names Ignored for Guix: --enable-fast-install Ignored for Debian: --disable-dependency-tracking --disable-maintainer-mode --includedir=DIR --libdir=DIR --libexecdir=DIR --localstatedir=DIR --runstatedir=DIR Some influential environment variables: CC C compiler command CFLAGS C compiler flags GUILE guile command GUILD guild command MES_FOR_BUILD build system MES [can be mes or guile] MES_SEED location of mes-seed TINYCC_PREFIX location of tinycc [for tests/test2] " PACKAGE VERSION (getenv "prefix"))) (define (main args) (let* ((options (parse-opts args)) (build-type (option-ref options 'build %host-type)) (host-type (option-ref options 'host %host-type))(prefix "/usr/local") (prefix "/usr/local") (prefix (option-ref options 'prefix prefix)) (program-prefix (option-ref options 'program-prefix "")) (program-suffix (option-ref options 'program-suffix "")) (infodir (option-ref options 'infodir "${prefix}/share/info")) (mandir (option-ref options 'infodir "${prefix}/share/man")) (sysconfdir (option-ref options 'sysconfdir "${prefix}/etc")) (bindir (option-ref options 'bindir "${prefix}/bin")) (datadir (option-ref options 'datadir "${prefix}/share")) (docdir (option-ref options 'docdir "${datadir}/doc/mes-${VERSION}")) (libdir (option-ref options 'libdir "${prefix}/lib")) (moduledir "${datadir}/mes/module") (moduledir/ (string-append (gulp-pipe* "echo" prefix) "/share/mes/module/")) (guile-effective-version (effective-version)) (guile-site-dir (if (equal? prefix ".") (canonicalize-path ".") (string-append prefix "/share/guile/site/" guile-effective-version))) (guile-site-ccache-dir (if (equal? prefix ".") (canonicalize-path ".") (string-append prefix "/lib/guile/" guile-effective-version "/site-ccache"))) (srcdir (dirname (car (command-line)))) (srcdest (if (equal? srcdir ".") "" (string-append srcdir "/"))) (abs-top-srcdir (canonicalize-path srcdir)) (abs-top-builddir (canonicalize-path (getcwd))) (top-builddir (if (equal? srcdir ".") "." abs-top-builddir)) (with-cheating? (option-ref options 'with-cheating #f)) (with-courage? (option-ref options 'with-courage #f)) (disable-silent-rules? (option-ref options 'disable-silent-rules #f)) (enable-silent-rules? (option-ref options 'enable-silent-rules #f)) (vars (filter (cut string-index <> #\=) (option-ref options '() '()))) (help? (option-ref options 'help #f)) (mes? (option-ref options 'mes #f))) (when help? (print-help) (exit 0)) (set! %verbose? (option-ref options 'verbose #f)) (when %verbose? (stderr "configure args=~s\n" args)) (for-each (lambda (v) (apply setenv (string-split v #\=))) vars) (let* ((mes-seed (or (getenv "MES_SEED") (string-append srcdest "../mes-seed"))) (mes-seed (and mes-seed (file-exists? (string-append mes-seed "/x86-mes/mes.S")) mes-seed)) (tinycc-prefix (or (getenv "TINYCC_PREFIX") (string-append srcdest "../tinycc-prefix"))) (gcc (or (getenv "CC") "gcc")) (tcc (or (getenv "TCC") "tcc")) (mescc (or (getenv "MESCC") "mescc")) (deps (fold (lambda (program results) (cons (check-program-version program) results)) '() (list (make-dep "hex2" #:version '(0 3)) (make-dep "M1" #:version '(0 3)) (make-dep "blood-elf" #:version '(0 1)) (make-dep "guile" #:version '(2 0) #:commands '("guile-2.2" "guile-2.0" "guile-2" "guile") #:optional? #t) (make-dep "mes" #:version '(0 18) #:optional? #t) (make-dep "guix" #:version '(0 13) #:optional? #t) (make-dep "ar" #:version '(2 10) #:optional? #t) (make-dep "sh" #:version '(0) #:optional? #t) (make-dep "bash" #:version '(2 0) #:optional? #t) (make-dep "guild" #:version '(2 0) #:commands '("guild" "guile-tools")) (make-dep "cc" #:commands (list gcc tcc mescc) #:optional? #t) (make-dep "make" #:optional? #t) (make-dep "makeinfo" #:optional? #t) (make-dep "dot" #:version-option "-V" #:optional? #t) (make-dep "help2man" #:version '(1 47) #:optional? #t) (make-dep "perl" #:version '(5) #:optional? #t) (make-dep "git" #:version '(2) #:optional? #t)))) (guile (file-name "guile" deps)) (deps (if guile (cons (check-program-version (make-dep "nyacc" #:version '(0 86 0) #:commands (list (string-append guile " -c '(use-modules (nyacc lalr)) (display *nyacc-version*)'")) #:file-name #t)) deps) deps)) (guile (or guile "guile")) (cc (file-name "cc" deps)) (deps (if cc (cons* (check-header-c cc (make-dep "limits.h")) (check-header-c cc (make-dep "stdio.h" #:optional? #t)) deps) deps)) (deps (cons (check-file (make-dep "tinycc-prefix" #:optional? #t #:file-name tinycc-prefix)) deps)) (missing (filter (conjoin (negate dependency-file-name) (negate dependency-optional?)) deps)) (deps (if cc (cons (check-compile-c cc (make-dep "cc is GNU C" #:data "#if !defined (__GNUC__) #error no gnuc #endif ")) deps) deps)) (gcc? (file-name "cc is GNU C" deps)) (deps (if cc (cons (check-compile-c cc (make-dep "cc is Mes C" #:data "#if !defined (__MESC__) #error no mesc #endif ")) deps) deps)) (mesc? (file-name "cc is Mes C" deps)) (deps (if cc (cons (check-compile-c cc (make-dep "cc is Tiny CC" #:data "#if !defined (__TINYCC__) #error no tinycc #endif ")) deps) deps)) (tcc? (file-name "cc is Tiny CC" deps)) (deps (if cc (cons (check-link-c cc (make-dep "if cc can create executables" #:data "int main () {return 0;}")) deps) deps)) (mes? (or mes? (not (file-name "if cc can create executables" deps)))) (build-type (or (and cc (gulp-pipe* cc "-dumpmachine")) build-type)) (arch (car (string-split build-type #\-))) (arch (if (member arch '("i386" "i486" "i586" "i686")) "x86" arch)) (mes-arch arch) (mes-arch (if mes? (string-append mes-arch "-mes") mes-arch)) (mes-arch (if gcc? (string-append mes-arch "-gcc") mes-arch)) (mes-arch (if tcc? (string-append mes-arch "-gcc") mes-arch)) (posix? (and (not mesc?) (not mes?)))) (define* (substitute file-name pairs #:key (target (if (string-suffix? ".in" file-name) (string-drop-right file-name 3) file-name))) (system* "mkdir" "-p" (dirname target)) (with-output-to-file target (lambda _ (let ((in (open-input-file file-name))) (let loop ((line (read-line in 'concat))) (when (not (eof-object? line)) (display (fold (lambda (o result) (string-replace-string/all result (car o) (cdr o))) line pairs)) (loop (read-line in 'concat)))))))) (when (and (not (member arch '("x86" "x86_64"))) (not with-courage?)) (stderr "platform not supported: ~a, try --with-courage\n" arch) (exit 1)) (when (pair? missing) (stderr "\nMissing dependencies: ~a\n" (string-join (map dependency-name missing))) (exit 1)) (let ((git (find-dep "git" deps))) (when (and git (not (file-exists? ".git"))) ;; Debian wants to run `make clean' from a tarball (and (zero? (system* "git" "init")) (zero? (system* "git" "add" ".")) (zero? (system* "git" "commit" "--allow-empty" "-m" "Import mes"))))) (let ((pairs `(("@PACKAGE@" . ,PACKAGE) ("@VERSION@" . ,VERSION) ("@arch@" . ,arch) ("@build@" . ,build-type) ("@host@" . ,host-type) ("@gcc_p@" . ,(if gcc? "1" "")) ("@mes_arch@" . ,mes-arch) ("@mes_p@" . ,(if mes? "1" "")) ("@mesc_p@" . ,(if mesc? "1" "")) ("@posix_p@" . ,(if posix? "1" "")) ("@tcc_p@" . ,(if tcc? "1" "")) ("@abs_top_srcdir@" . ,abs-top-srcdir) ("@abs_top_builddir@" . ,abs-top-builddir) ("@top_builddir@" . ,top-builddir) ("@srcdest@" . ,srcdest) ("@srcdir@" . ,srcdir) ("@prefix@" . ,prefix) ("@program_prefix@" . ,program-prefix) ("@bindir@" . ,bindir) ("@datadir@" . ,datadir) ("@docdir@" . ,docdir) ("@guile_site_ccache_dir@" . ,guile-site-ccache-dir) ("@guile_site_dir@" . ,guile-site-dir) ("@infodir@" . ,infodir) ("@libdir@" . ,libdir) ("@mandir@" . ,mandir) ("@moduledir@" . ,moduledir) ("@sysconfdir@" . ,sysconfdir) ("@GUILE_EFFECTIVE_VERSION@" . ,(effective-version)) ("@V@" . ,(if disable-silent-rules? 1 0)) ("@AR@" . ,(or (file-name "ar" deps) "")) ("@BASH@" . ,(or (file-name "bash" deps) "")) ("@CC@" . ,(or (file-name "cc" deps) "")) ("@DOT@" . ,(or (file-name "dot" deps) "")) ("@GIT@" . ,(or (file-name "git" deps) "")) ("@GUILE@" . ,guile) ("@GUIX@" . ,(or (file-name "guix" deps) "")) ("@HELP2MAN@" . ,(or (file-name "help2man" deps) "")) ("@MAKEINFO@" . ,(or (file-name "makeinfo" deps) "")) ("@MES_FOR_BUILD@" . ,(or (file-name "mes" deps) guile)) ("@MES_SEED@" . ,(or mes-seed "")) ("@PERL@" . ,(or (file-name "perl" deps) "")) ("@SHELL@" . ,(or (file-name "sh" deps) "")) ("@CFLAGS@" . ,(or (getenv "CFLAGS") "")) ("@HEX2FLAGS@" . ,(or (getenv "HEX2FLAGS") "")) ("@M1FLAGS@" . ,(or (getenv "M1FLAGS") "")) ("mes/module/" . ,(string-append moduledir/)) ,@(map (lambda (o) (cons (string-append "@" (variable-name o) "@") (or (format #f "~a" (dependency-file-name o)) ""))) deps)))) (when (and (not cc) (not mes-seed)) (format (current-error-port) "must supply C compiler or MES_SEED/x86-mes/mes.S\n") (exit 2)) (for-each (lambda (o) (let* ((src (string-append srcdest o)) (target (string-drop-right o 3)) (target (if (not (string-prefix? "build-aux/" target)) target (string-drop target (string-length "build-aux/"))))) (substitute src pairs #:target target))) '( "build-aux/GNUmakefile.in" "build-aux/config.status.in" "build-aux/build.sh.in" "build-aux/bootstrap.sh.in" "build-aux/check.sh.in" "build-aux/install.sh.in" "build-aux/pre-inst-env.in" "build-aux/uninstall.sh.in" "mes/module/mes/boot-0.scm.in" "scripts/mescc.scm.in" "scripts/mescc.in" )) (chmod "pre-inst-env" #o755) (chmod "scripts/mescc" #o755) (chmod "scripts/mescc.scm" #o755) (chmod "build.sh" #o755) (chmod "bootstrap.sh" #o755) (chmod "check.sh" #o755) (chmod "install.sh" #o755) (chmod "uninstall.sh" #o755) (substitute (string-append srcdest "build-aux/config.make.in") pairs #:target ".config.make")) (let ((make (and=> (file-name "make" deps) basename))) (format (current-output-port) " GNU Mes is configured for ~a Run: ~a to build mes ~a help for help on other targets\n" mes-arch (or make "./build.sh") (or make "./build.sh"))))))