[PATCH] Add `emit-types-file` declaration

[Evan Hanson]

---
 NEWS                |  3 +++
 batch-driver.scm    | 12 +++++++-----
 core.scm            | 12 ++++++++++--
 manual/Declarations | 10 ++++++++++
 4 files changed, 30 insertions(+), 7 deletions(-)

diff --git a/NEWS b/NEWS
index 18c225c5..448fc1ac 100644
--- a/NEWS
+++ b/NEWS
@@ -45,6 +45,9 @@
 - Compiler
   - Avoid re-using argvector when inline rest operations are being
     used in CPS calls (#1703, thanks to Jakob L. Keuze).
+  - An `emit-types-file` declaration has been added, which corresponds
+    to the compiler flag of the same name (#1644, thanks to Marco Maggi
+    for the suggestion).
 
 - Build system
   - Auto-configure at build time on most platforms. Cross-compilation
diff --git a/batch-driver.scm b/batch-driver.scm
index 857dfbad..78296c9d 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -232,7 +232,6 @@
        (time-breakdown #f)
        (forms '())
        (inline-output-file #f)
-       (type-output-file #f)
        (profile (or (memq 'profile options)
                     (memq 'accumulate-profile options) 
                     (memq 'profile-name options)))
@@ -392,7 +391,7 @@
       (set! local-definitions #t)
       (set! inline-output-file (option-arg ifile)))
     (and-let* ((tfile (memq 'emit-types-file options)))
-      (set! type-output-file (option-arg tfile)))
+      (set! types-output-file (option-arg tfile)))
     (and-let* ([inlimit (memq 'inline-limit options)])
       (set! inline-max-size 
        (let ([arg (option-arg inlimit)])
@@ -759,9 +758,12 @@
                       (when (memq 'v debugging-chicken)
                         (dump-global-refs db))
                       ;; do this here, because we must make sure we have a db
-                      (when type-output-file
-                        (dribble "generating type file `~a' ..." 
type-output-file)
-                        (emit-types-file filename type-output-file db 
block-compilation)))
+                      (and-let* ((tfile (or (and (eq? types-output-file #t)
+                                                 (pathname-replace-extension 
filename "types"))
+                                            (and (string? types-output-file)
+                                                 types-output-file))))
+                        (dribble "generating type file `~a' ..." tfile)
+                        (emit-types-file filename tfile db block-compilation)))
                     (set! first-analysis #f)
                     (end-time "analysis")
                     (print-db "analysis" '|4| db i)
diff --git a/core.scm b/core.scm
index fa19c354..4001fa05 100644
--- a/core.scm
+++ b/core.scm
@@ -49,6 +49,7 @@
 ; (compile-syntax)
 ; (disable-interrupts)
 ; (emit-import-library {<module> | (<module> <filename>)})
+; (emit-types-file [<filename>])
 ; (export {<name>})
 ; (fixnum-arithmetic)
 ; (foreign-declare {<string>})
@@ -299,7 +300,7 @@
      optimize-leaf-routines standalone-executable undefine-shadowed-macros
      verbose-mode local-definitions enable-specialization block-compilation
      inline-locally inline-substitutions-enabled strict-variable-types
-     static-extensions emit-link-file
+     static-extensions emit-link-file types-output-file
 
      ;; These are set by the (batch) driver, and read by the (c) backend
      disable-stack-overflow-checking emit-trace-info external-protos-first
@@ -422,6 +423,7 @@
 (define enable-specialization #f)
 (define static-extensions #f)
 (define emit-link-file #f)
+(define types-output-file #f) ; #t | <filename>
 
 ;;; Other global variables:
 
@@ -1711,12 +1713,18 @@
                  (cond ((symbol? il)
                         (cons il (string-append (symbol->string il) 
".import.scm")) )
                        ((and (list? il) (= 2 (length il))
-                             (symbol? (car il)) (string (cadr il)))
+                             (symbol? (car il)) (string? (cadr il)))
                         (cons (car il) (cadr il)))
                        (else
                         (warning
                          "invalid import-library specification" il))))
                (strip-syntax (cdr spec))))))
+       ((emit-types-file)
+        (unless types-output-file
+          (set! types-output-file
+            (or (null? (cdr spec))
+                (and (string? (cadr spec)) (null? (cddr spec)) (cadr spec))
+                (quit-compiling "invalid `emit-types-file' declaration: ~S" 
spec)))))
        ((profile)
        (set! emit-profile #t)
        (cond ((null? (cdr spec))
diff --git a/manual/Declarations b/manual/Declarations
index 52500dc4..04132afc 100644
--- a/manual/Declarations
+++ b/manual/Declarations
@@ -114,6 +114,16 @@ Note that the import library is only generated if it 
cannot be found in the curr
 directory, or if it exists but is not equal to the one that would be generated.
 
 
+=== emit-types-file
+
+ [declaration specifier] (emit-types-file [FILENAME])
+
+Enables generation of a types file for the current compilation unit, which will
+be written to the specified {{FILENAME}} or to {{<source-filename>.types}} in 
the
+current directory. This filename can be overridden with the 
{{-emit-types-file}}
+command line flag, which takes precedence over this declaration.
+
+
 === inline
 
  [declaration specifier] (inline)
-- 
2.29.3