mes/configure

#! /bin/sh
# -*- scheme -*-
unset LANG LC_ALL
echo -n "checking for guile..."
GUILE=$(command -v ${GUILE-guile})
GUIX=$(command -v ${GUIX-guix})
export GUILE GUIX
if [ -x "$GUILE" ]; then
    echo " $GUILE"
elif [ -x "$GUIX" ]; then
    cat <<EOF
not found
Missing dependencies, run

    guix environment -l guix.scm
EOF
    exit 1
else
cat <<EOF
not found
Missing dependencies, run

    sudo apt-get install guile-2.2
EOF
    exit 1
fi
exec ${GUILE-guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
!#

;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; configure: This file is part of Mes.
;;;
;;; 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.
;;;
;;; 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 Mes.  If not, see <http://www.gnu.org/licenses/>.

(define-module (configure)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 and-let-star)
  #:use-module (ice-9 curried-definitions)
  #:use-module (ice-9 getopt-long)
  #:use-module (ice-9 match)
  #:use-module (ice-9 optargs)
  #:use-module (ice-9 popen)
  #:use-module (ice-9 rdelim)
  #:export (main))

(define *shell* "sh")
(define PACKAGE "mes")
(define VERSION "0.14")
(define PREFIX "/usr/local")
(define GUILE_EFFECTIVE_VERSION (effective-version))
(define GUILE (or (getenv "guile") "guile"))
(define SYSCONFDIR "$(PREFIX)/etc")

;;; 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* ((port (open-pipe* OPEN_READ *shell* "-c" command))
         (output (read-string port))
         (status (close-pipe port)))
    (verbose "command[~a]: ~s => ~a\n" status command output)
    (if (not (zero? status)) "" (string-trim-right output #\newline))))

(define* ((->string #:optional (infix "")) h . t)
  (let ((o (if (pair? t) (cons h t) h)))
    (match o
      ((? char?) (make-string 1 o))
      ((? number?) (number->string o))
      ((? string?) o)
      ((? symbol?) (symbol->string o))
      ((h ... t) (string-join (map (->string) o) ((->string) infix)))
      (_ ""))))

(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)))

;;; Configure
(define (version->string version)
  ((->string '.) version))

(define (string->version string)
  (and-let* ((version (string-tokenize string
                                       (char-set-adjoin char-set:digit #\.)))
             ((pair? version))
             (version (sort version (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* (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 optional '())
(define required '())
(define* (check-version name expected
                        #:key
                        optional?
                        (deb #f)
                        (version-option '--version)
                        (compare tuple<=)
                        (command name))
  (stderr "checking for ~a~a..." (basename name)
          (if (null? expected) ""
              (format #f " [~a]" (version->string expected))))
  (let* ((output (gulp-pipe (format #f "~a ~a 2>&1" command version-option)))
         (actual (string->version output))
         (pass? (and actual (compare expected actual)))
         ;(pass? (PATH-search-path command))
         )
    (stderr "~a ~a\n" (if pass? (if (pair? actual) "" " yes")
                          (if actual " no, found" "")) (version->string actual))
    (or pass?
        (if (not (pair? name)) (begin (if optional? (set! optional (cons (or deb name) optional))
                                          (set! required (cons (or deb name) required)))
                                      pass?)
            (check-version (cdr name) expected deb version-option compare)))))

(define* (check-pkg-config package expected #:optional (deb #f))
  (check-version (format #f "pkg-config --modversion ~a" package) expected deb))

(define (check-compile-header-c header)
  (and (= 0 (system (format #f "echo '#include ~s' | gcc -E - > /dev/null 2>&1" header)))
       'yes))

(define (check-compile-header-c++ header)
  (and (= 0 (system (format #f "echo '#include ~s' | gcc --language=c++ --std=c++11 -E - > /dev/null 2>&1" header)))
       'yes))

(define* (check-header-c header deb #:optional (check check-compile-header-c))
  (stderr "checking for ~a..." header)
  (let ((result (check header)))
    (stderr " ~a\n" (if result result "no"))
    (if (not result)
        (set! required (cons deb required)))))

(define* (check-header-c++ header deb #:optional (check check-compile-header-c++))
  (check-header-c header deb check))

(define guix?
  (and (zero? (system "guix --version 1>/dev/null 2>/dev/null")) 1))
;;;

(define (parse-opts args)
  (let* ((option-spec
  	  '((build (value #t))
            (host (value #t))
            (help (single-char #\h))
            (prefix (value #t))
            (sysconfdir (value #t))
            (verbose (single-char #\v))
            (with-courage)
            ;;ignore
            (enable-fast-install))))
    (getopt-long args option-spec #:stop-at-first-non-option #t)))

(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]
      --host=HOST      cross-compile to build programs to run on HOST [BUILD]
  -v, --verbose        be verbose
  --with-courage       assert being courageous to configure for unsupported platform

Installation directories:
  --prefix=DIR         install in PREFIX [~a]
  --sysconfdir=DIR     read-only single-machine data [PREFIX/etc]

Some influential environment variables:
  CC          C compiler command
  CFLAGS      C compiler flags
  CC32        x86 C compiler command
  C32FLAGS    x86 C compiler flags
  GUILE       guile command
  GUILE_TOOLS guile-tools command
  MES_SEED    location of mes-seed
  TINYCC_SEED location of tinycc-seed
" PACKAGE VERSION (getenv "PREFIX")))

(define (main args)
  (let* ((CC (or (getenv "CC") "gcc"))
         (BUILD_TRIPLET %host-type)
         (ARCH (car (string-split BUILD_TRIPLET #\-)))
         (options (parse-opts args))
         (build-triplet (option-ref options 'build BUILD_TRIPLET))
         (host-triplet (option-ref options 'host BUILD_TRIPLET))
         (prefix (option-ref options 'prefix PREFIX))
         (sysconfdir (option-ref options 'sysconfdir SYSCONFDIR))
         (verbose? (option-ref options 'verbose #f))
         (with-courage? (option-ref options 'with-courage #f))
         (make? #f)
         (vars (filter (cut string-index <> #\=) (option-ref options '() '())))
         (help? (option-ref options 'help #f)))
    (for-each (lambda (v) (apply setenv (string-split v #\=))) vars)
    (let ((CC32 (or (getenv "CC32")
                    (if (member ARCH '("i686" "arm")) (string-append BUILD_TRIPLET "-" CC)
                        "i686-unknown-linux-gnu-gcc")))
          (GUILE_TOOLS (or (getenv "GUILE_TOOLS") "guile-tools"))
          (BLOOD_ELF (or (getenv "BLOOD_ELF") "blood-elf"))
          (HEX2 (or (getenv "HEX2") "hex2"))
          (M1 (or (getenv "M1") "M1"))
          (CFLAGS (getenv "CFLAGS"))
          (C32FLAGS (getenv "C32FLAGS"))
          (HEX2FLAGS (getenv "HEX2FLAGS"))
          (M1FLAGS (getenv "M1FLAGS"))
          (MESCCFLAGS (getenv "MESCCFLAGS"))
          (MES_SEED (or (getenv "MES_SEED") "../mes-seed"))
          (TINYCC_SEED (or (getenv "TINYCC_SEED") "../tinycc-seed")))
      (when help?
        (print-help)
        (exit 0))
      (set! *verbose?* verbose?)
      (check-version "guile" '(2 0))
      (check-version "guile-tools" '(2 0))
      (check-version "mes-seed" '(0 14) #:optional? #t #:command (string-append MES_SEED "/refresh.sh"))
      (check-version "tinycc-seed" '(0 14) #:optional? #t #:command (string-append TINYCC_SEED "/refresh.sh"))
      (check-version BLOOD_ELF '(0 1))
      (check-version HEX2 '(0 3))
      (check-version M1 '(0 3))
      (check-version "nyacc" '(0 80 41) #:command (string-append GUILE " -c '(use-modules (nyacc lalr)) (display *nyacc-version*)'"))

      (check-version "bash" '(4 0))
      (when (and (not (member ARCH '("i686" "x86_64"))) (not with-courage?))
        (stderr "platform not supported: ~a, try --with-courage\n" ARCH)
        (exit 1))
      (if (not (check-version CC '(4 8) #:optional? #t))
          (set! CC #f))
      (when CC
        (check-header-c "stdio.h" "libc-dev")
        (check-header-c "limits.h" "linux-headers"))
      (if (not (check-version CC32 '(4 8) #:optional? #t))
          (set! CC32 #f))
      (set! make? (check-version "make" '(4 0) #:optional? #t))
      (check-version "perl" '(5))

      (when (pair? required)
        (stderr "\nMissing dependencies [~a], run\n\n" ((->string ", ") required))
        (if guix?
            (stderr "    guix environment -l guix.scm\n")
            (stderr "    sudo apt-get install ~a\n" ((->string " ") required)))
        (exit 1))
      (with-output-to-file ".config.make"
        (lambda ()
          (stdout "build:=~a\n" build-triplet)
          (stdout "host:=~a\n" host-triplet)
          (stdout "srcdir:=.\n")
          (stdout "ARCH:=~a\n" ARCH)
          (stdout "CC:=~a\n" (or CC ""))
          (stdout "CC32:=~a\n" (or CC32 ""))
          (stdout "BLOOD_ELF:=~a\n" (or BLOOD_ELF ""))
          (stdout "MES_SEED:=~a\n" (or MES_SEED ""))
          (stdout "TINYCC_SEED:=~a\n" (or TINYCC_SEED ""))
          (stdout "HEX2:=~a\n" (or HEX2 ""))
          (stdout "M1:=~a\n" (or M1 ""))
          (stdout "GUILE:=~a\n" GUILE)
          (stdout "GUILE_TOOLS:=~a\n" GUILE_TOOLS)
          (stdout "GUILE_FOR_BUILD:=~a\n" GUILE)
          (stdout "GUILE_EFFECTIVE_VERSION:=~a\n" GUILE_EFFECTIVE_VERSION)
          (stdout "GUIX_P:=~a\n" (if guix? guix? ""))
          (stdout "HEX2:=~a\n" (or HEX2 ""))
          (stdout "PACKAGE:=~a\n" PACKAGE)
          (stdout "VERSION:=~a\n" VERSION)
          (stdout "PREFIX:=~a\n" (gulp-pipe (string-append "echo " prefix)))
          (stdout "SYSCONFDIR:=~a\n" sysconfdir)
          (when CFLAGS (stdout "CFLAGS:=~a\n" CFLAGS))
          (when C32FLAGS (stdout "C32FLAGS:=~a\n" C32FLAGS))
          (when HEX2FLAGS (stdout "HEX2FLAGS:=~a\n" HEX2FLAGS))
          (when M1FLAGS (stdout "M1FLAGS:=~a\n" M1FLAGS))
          (when MESCCFLAGS (stdout "MESCCFLAGS:=~a\n" MESCCFLAGS))))
      (format (current-output-port)
              "\nRun:
  ~a            to build mes
  ~a help       for help on other targets\n"
              (if make? "make" "./build.sh")
              (if make? "make" "./build.sh")))))