From 768fd298f69897ec9e5e8ded9a014b03023be86d Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Fri, 27 Oct 2017 11:01:47 +0200
Subject: [PATCH] chicken-install: allow preexisting .types files

The `types-file' egg extension property now may be `(predefined [NAME])`
to specify an already existing .types file that should be installed.
---
 chicken-install.scm |    9 ++++++++-
 egg-compile.scm     |   22 +++++++++++++++++++---
 manual/Extensions   |    4 ++++
 3 files changed, 31 insertions(+), 4 deletions(-)

diff --git a/chicken-install.scm b/chicken-install.scm
index 0162feb..3e51abd 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -161,6 +161,13 @@
 (define (nameprop? x)
   (and (list? x) (or (symbol? (car x)) (string? (car x)))))
 
+(define (name-or-predefd? x)
+  (or (optname? x)
+      (and (pair? x)
+           (pair? (car x))
+           (eq? 'predefined (caar x))
+           (optname? (cdar x)))))
+
 ;; ENTRY = (NAME TOPLEVEL? NESTED? NAMED? [VALIDATOR])
 (define egg-info-items
   `((synopsis #t #f #f)
@@ -185,7 +192,7 @@
     (install-name #f #f #f ,nameprop?)
     (target #f #t #f)
     (host #f #t #f)
-    (types-file #f #f #f ,optname?)
+    (types-file #f #f #f ,name-or-predefd?)
     (inline-file #f #f #f ,optname?)
     (extension #f #t #t)
     (generated-source-file #f #t #t)
diff --git a/egg-compile.scm b/egg-compile.scm
index ac74818..d062fc5 100644
--- a/egg-compile.scm
+++ b/egg-compile.scm
@@ -138,6 +138,7 @@
         (opts '())
         (mods #f)
         (tfile #f)
+        (ptfile #f)
         (ifile #f)
         (objext (object-extension platform))
         (exeext (executable-extension platform)))
@@ -159,6 +160,7 @@
                       (cbuild #f)
                       (link default-extension-linkage)
                       (tfile #f)
+                      (ptfile #f)
                       (ifile #f)
                       (lopts '())
                       (oname #f)
@@ -187,6 +189,7 @@
                 (cons (list target dependencies: deps source: src options: opts
                             link-options: lopts linkage: link custom: cbuild
                             mode: mode types-file: tfile inline-file: ifile
+                            predefined-types: ptfile
                             modules: (or mods (list rtarget))
                             output-file: rtarget)
                     exts)))))
@@ -276,7 +279,16 @@
         ((linkage) 
          (set! link (cdr info)))
         ((types-file)
-         (set! tfile (or (null? (cdr info)) (arg info 1 name?))))
+         (set! tfile
+           (cond ((null? (cdr info)) #t)
+                 ((not (pair? (cadr info)))
+                  (arg info 1 name?))
+                 (else
+                   (set! ptfile #t)
+                   (set! tfile
+                     (or (null? (cdadr info))
+                         #t
+                         (arg (cadr info) 1 name?)))))))
         ((inline-file)
          (set! ifile (or (null? (cdr info)) (arg info 1 name?))))
         ((custom-build)
@@ -426,6 +438,7 @@
 
 (define ((compile-static-extension name #!key mode dependencies
                                    source (options '())
+                                   predefined-types
                                    custom types-file inline-file)
          srcdir platform)
   (let* ((cmd (or (and custom (prefix-custom-command custom))
@@ -435,7 +448,8 @@
          (opts (append (if (null? options)
                            default-static-compilation-options
                            options)
-                       (if types-file
+                       (if (and types-file
+                                (not predefined-types))
                            (list "-emit-type-file"
                                  (quotearg (prefix srcdir (conc types-file ".types"))))
                            '())
@@ -462,6 +476,7 @@
 
 (define ((compile-dynamic-extension name #!key mode dependencies mode
                                     source (options '()) (link-options '()) 
+                                    predefined-types
                                     custom types-file inline-file)
          srcdir platform)
   (let* ((cmd (or (and custom (prefix-custom-command custom)) 
@@ -470,7 +485,8 @@
          (opts (append (if (null? options)
                            default-dynamic-compilation-options
                            options)
-                       (if types-file
+                       (if (and types-file
+                                (not predefined-types))
                            (list "-emit-type-file"
                                  (quotearg (prefix srcdir (conc types-file ".types"))))
                            '())
diff --git a/manual/Extensions b/manual/Extensions
index ba6536e..c73b5c4 100644
--- a/manual/Extensions
+++ b/manual/Extensions
@@ -297,6 +297,10 @@ installed for this component. This property is only used for
 extension libraries. The name is optional and defaults to the
 name of the extensions (with the proper extension).
 
+If {{NAME}} is a list of the form {{(predefined [NAME])}}, then
+no types file is created during compilation and an existing types file 
+for this extension is assumed and installed.
+
 ====== inline-file
 
 [egg property] (inline-file [NAME])
-- 
1.7.9.5