~ chicken-core (chicken-5) f701e594dd59b8ab4dc04d340e81440f84ae5d9a


commit f701e594dd59b8ab4dc04d340e81440f84ae5d9a
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Nov 13 17:11:52 2018 +0100
Commit:     Kooda <kooda@upyum.com>
CommitDate: Sun Nov 18 20:50:25 2018 +0100

    Add support for cond-expand and error forms in .egg files.
    
    Adds "cond-expand" and "error" egg specification forms, usable
    at both toplevel and component-level. Also revives the "-feature"
    option for "chicken-install" to allow configuring build variants or
    options during egg installation.
    
    Signed-off-by: Kooda <kooda@upyum.com>

diff --git a/NEWS b/NEWS
index 31fded0f..c643784b 100644
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,9 @@
   - It is now possible to quote free variables in type declarations,
      which acts as shorthand for `forall' (thanks to "megane")
 
+- Egg specifications
+  - Allows "cond-expand" and "error" forms in egg specification files.
+
 
 5.0.0
 
diff --git a/chicken-install.mdoc b/chicken-install.mdoc
index 284e74fc..1b2f940f 100644
--- a/chicken-install.mdoc
+++ b/chicken-install.mdoc
@@ -99,6 +99,10 @@ which has the same format as
 This option may be given multiple times.
 .It Fl cached
 Install given eggs from cache and do not download.
+.It Fl feature , Fl D Ar name
+Register feature 
+.Ar name ,
+usable as a condition in cond-expand clauses.
 .El
 .Sh ENVIRONMENT
 Following environment variables change the behaviour of
diff --git a/chicken-install.scm b/chicken-install.scm
index 5774df92..2111695b 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -195,6 +195,8 @@
     (data #f #t #t)
     (modules #f #f #f)
     (component-options #t #f #f)
+    (cond-expand * #t #f)
+    (error * #f #f)
     (c-include #f #f #t)
     (scheme-include #f #f #t)))
 
@@ -208,11 +210,15 @@
                (error "invalid egg information item" item))
               ((assq (car item) egg-info-items) =>
                (lambda (a)
-                 (apply (lambda (_ toplevel nested named #!optional validator)
-                          (cond ((and top? (not toplevel))
+                 (apply (lambda (name toplevel nested named #!optional validator)
+                          (cond ((and top? 
+                                      (not (eq? toplevel '*))
+                                      (not toplevel))
                                  (error "egg information item not allowed at toplevel" 
                                         item))
-                                ((and toplevel (not top?))
+                                ((and (not (eq? toplevel '*))
+                                      toplevel
+                                      (not top?))
                                  (error "egg information item only allowed at toplevel" item))
                                 ((and named
                                       (or (null? (cdr item))
@@ -222,7 +228,16 @@
                                       (not (validator (cdr item))))
                                  (error "egg information item has invalid structure" item)))
                           (when nested
-                            (validate (if named (cddr item) (cdr item)) #f)))
+                            (cond (named (validate (cddr item) #f))
+                                  ((eq? name 'cond-expand)
+                                   (for-each
+                                     (lambda (clause)
+                                       (unless (and (list? clause)
+                                                    (>= (length clause) 1))
+                                         (error "invalid syntax in `cond-expand' clause" clause))
+                                       (validate (cdr clause) top?))
+                                     (cdr item)))
+                                  (else (validate (cdr item) #f)))))
                         a)))
               (else (error "unknown egg information item" item))))
       info))
@@ -232,7 +247,7 @@
 
 ;; utilities
 
-;; Simpler replacement for SRFI-13's string-suffix?
+;; Simpler replacement for SRFI-13's "string-suffix?"
 (define (string-suffix? suffix s)
   (let ((len-s (string-length s))
         (len-suffix (string-length suffix)))
@@ -1037,6 +1052,7 @@ usage: chicken-install [OPTION ...] [NAME[:VERSION] ...]
        -from-list FILENAME      install eggs from list obtained by `chicken-status -list'
   -v   -verbose                 be verbose
        -cached                  only install from cache
+  -D   -feature NAME            define build feature
        -defaults FILENAME       use FILENAME as defaults instead of the installed `setup.defaults'
                                 file
 
@@ -1075,6 +1091,9 @@ EOF
                   ((equal? arg "-version")
                    (print (chicken-version))
                    (exit 0))
+                  ((member arg '("-D" "-feature"))
+                   (register-feature! (cadr args))
+                   (loop (cddr args)))
                   ((equal? arg "-recursive")
                    (set! retrieve-recursive #t)
                    (loop (cdr args)))
diff --git a/egg-compile.scm b/egg-compile.scm
index bff0383e..bbf59858 100644
--- a/egg-compile.scm
+++ b/egg-compile.scm
@@ -116,6 +116,25 @@
       (list (implib rtarget))))
 
 
+;;; check condition in conditional clause
+
+(define (check-condition tst mode link)
+  (define (fail x)
+    (error "invalid conditional expression in `cond-expand' clause"
+           x))
+  (let walk ((x tst))
+    (cond ((and (list? x) (pair? x))
+           (cond ((and (eq? (car x) 'not) (= 2 (length x)))
+                  (not (walk (cadr x))))
+                 ((eq? 'and (car x)) (every walk (cdr x)))
+                 ((eq? 'or (car x)) (any walk (cdr x)))
+                 (else (fail x))))
+          ((memq x '(dynamic static)) (memq x link))
+          ((memq x '(target host)) (memq x mode))
+          ((symbol? x) (feature? x))
+          (else (fail x)))))
+
+
 ;;; compile an egg-information tree into abstract build/install operations
 
 (define (compile-egg-info eggfile info version platform mode)
@@ -321,7 +340,11 @@
            (for-each walk (cdr info))))
         ((host)
          (when (eq? mode 'host)
-           (for-each walk (cdr info))))))
+           (for-each walk (cdr info))))
+        ((error)
+         (apply error (cdr info)))
+        ((cond-expand)
+         (compile-cond-expand info walk))))
     (define (compile-data/include info)
       (case (car info)
         ((destination)
@@ -334,6 +357,15 @@
         ((csc-options) (set! opts (append opts (cdr info))))
         ((link-options) (set! lopts (append lopts (cdr info))))
         (else (error "invalid option specification" info))))
+    (define (compile-cond-expand info walk)
+      (let loop ((clauses (cdr info)))
+        (cond ((null? clauses)
+               (error "no matching clause in `cond-expand' form" 
+                      info))
+              ((or (eq? 'else (caar clauses))
+                   (check-condition (caar clauses) mode link))
+               (for-each walk (cdar clauses)))
+              (else (loop (cdr clauses))))))
     (define (->dep x)
       (if (name? x) x (error "invalid dependency" x)))
     (define (compile info)
diff --git a/manual/Egg specification format b/manual/Egg specification format
index bd7da264..3268f4d6 100644
--- a/manual/Egg specification format	
+++ b/manual/Egg specification format	
@@ -147,6 +147,28 @@ intended for cross compilation.
 Specifies global options for all programs and extensions compiled for this egg.
 {{OPTIONSPEC}} may be {{csc-options}} or {{link-options}} specifications.
 
+==== cond-expand
+
+[egg property] (cond-expand CLAUSE ...)
+
+Conditionally expand egg specification forms, depending on system 
+features. Each {{CLAUSE}} should be of the form 
+{{(TEST PROPERTY)}} where {{TEST}} is a feature identifier or a 
+conditional form, in the same syntax as used in the {{cond-expand}}
+syntactic form.
+
+In addition to normal system-wide feature identifiers, feature identifiers
+given via the {{-feature}} option to {{chicken-install}} are visible in
+the tests. Also, the features {{target}}, {{host}}, {{dynamic}} and
+{{static}} are visible, depending on surrounding egg specification
+forms for constraining mode and linkage.
+
+==== error
+
+[egg property] (error STRING ARG ...)
+
+Signal an error and abort processing. Mostly useful inside {{cond-expand}} forms.
+
 === Components
 
 ==== extension
@@ -260,7 +282,6 @@ are set in the execution environment of the script:
 * {{CHICKEN_CSC}}: path to {{csc}}
 * {{CHICKEN_CSI}}: path to {{csi}}
 
-
 ==== csc-options
 
  [egg property] (csc-options OPTION ...)
@@ -359,6 +380,19 @@ Specifies modules that the component (usually an extension) contains.
 If this property is not given, then it is assumed that the extension has a single
 module of the same name as the component.
 
+==== cond-expand
+
+ [egg property] (cond-expand CLAUSE ...)
+
+Similar to the toplevel {{cond-expand}} clause and may appear inside
+component specifications.
+
+==== error
+
+ [egg property] (error STRING ARG ...)
+
+Similar to the toplevel {{error}} form, may appear inside component specifications.
+
 ---
 
 Previous: [[Extension tools]]
diff --git a/manual/Extension tools b/manual/Extension tools
index 8d28a01e..dc0fdcd6 100644
--- a/manual/Extension tools	
+++ b/manual/Extension tools	
@@ -232,6 +232,7 @@ Available options:
 ; {{-override FILENAME}} : override versions for installed eggs with information given in {{FILENAME}}, which can be generated by {{-scan}} or by the {{-list}} option of the {{chicken-status}} program
 ; {{-from-list FILENAME}} : install eggs given in {{FILENAME}}, in the same format as produced by the {{-list}} option in {{chicken-status}}; this option may be given multiple times
 ; {{-v   -verbose}} : be verbose
+; {{-D   -feature NAME}} : defines a build feature, that can be tested using {{cond-expand}} in egg specifications
 ; {{ -defaults FILENAME }} :  use {{FILENAME}} as defaults instead of the installed {{setup.defaults}} file
 
 {{chicken-install}} recognizes the {{SUDO}}, {{http_proxy}} and {{proxy_auth}} environment variables, if set.
Trap