mes/configure

#! /bin/sh
# -*- scheme -*-
unset LANG LC_ALL
echo -n "checking for guile..."
GUILE=$(command -v ${GUILE-guile} 2>/dev/null|tail -n 1|sed 's,^.* ,,')
export GUILE
if [ -x "$GUILE" ]; then
    echo " $GUILE"
else
    pm=$({ guix --help || dpkg --help; }|head -n 1|sed 's,.*Usage: \([^ ]*\).*,\1,g')
#-paredit:'})(
    case "$pm" in dpkg) message="sudo apt-get install guile-2.0";; *) message="guix environment guix.scm";; esac
    cat <<EOF
Missing dependencies, run

    $pm
EOF
    exit 1
fi
exec ${GUILE} --no-auto-compile -L $(pwd) -C $(pwd) -e 'main' -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 (main args)
  ((@@ (configure) main) args))

(define-module (configure)
  #: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))

(define *shell* "sh")
(define PACKAGE "mes")
(define VERSION "0.13")
(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 optional '())
(define required '())
(define* (check-version name expected
                        #:key
                        optional?
                        (deb #f)
                        (version-option '--version)
                        (compare tuple<=)
                        (command name))
  (stderr "checking for ~a~a..." 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))))
    (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 CC (or (getenv "CC") "gcc"))
(define BUILD_TRIPLET %host-type)
(define ARCH (car (string-split BUILD_TRIPLET #\-)))
(define CC32 (or (getenv "CC32")
                 (if (member ARCH '("i686" "arm")) (string-append BUILD_TRIPLET "-" CC)
                     "i686-unknown-linux-gnu-gcc")))
(define HEX2 (or (getenv "HEX2") "hex2"))
(define M1 (or (getenv "M1") "M1"))
(define CFLAGS (getenv "CFLAGS"))
(define C32FLAGS (getenv "C32FLAGS"))
(define HEX2FLAGS (getenv "HEX2FLAGS"))
(define M1FLAGS (getenv "M1FLAGS"))
(define MESCCFLAGS (getenv "MESCCFLAGS"))

(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)))
         (options (getopt-long args option-spec))
         (help? (option-ref options 'help #f))
         (files (option-ref options '() '()))
         (prefix (option-ref options '() PREFIX))
         (usage? (and (not help?) #f)))
    (if (pair? files)
        (stderr "ignoring files: ~a\n" files))
    (or (and (or help? usage?)
             ((or (and usage? stderr) stdout) "\
Usage: ./configure [OPTION]...
  -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]
  --prefix=DIR         install in PREFIX [~a]
  --sysconfdir=DIR     read-only single-machine data [PREFIX/etc]
  -v, --verbose        be verbose
  --with-courage       assert being courageous to configure for unsupported platform
" PREFIX)
             (exit (or (and usage? 2) 0)))
        options)))

(define (main args)
  (let* ((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))
    (set! *verbose?* verbose?)
    (check-version 'guile '(2 0))
    (check-version HEX2 '(0 1))
    (check-version M1 '(0 2))
    (check-version 'nyacc '(0 80 3) #: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 "HEX2:=~a\n" (or HEX2 ""))
        (stdout "M1:=~a\n" (or M1 ""))
        (stdout "GUILE:=~a\n" GUILE)
        (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"))))