~ chicken-core (chicken-5) 5273e12d9e6c05d95a5046ba3bf6898cc47ce9ea

commit 5273e12d9e6c05d95a5046ba3bf6898cc47ce9ea
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Sat Apr 10 02:27:58 2021 +0300
Commit:     megane <meganeka@gmail.com>
CommitDate: Wed Apr 21 14:57:52 2021 +0300

    Add `emit-types-file` declaration
    
    Signed-off-by: megane <meganeka@gmail.com>

diff --git a/NEWS b/NEWS
index aafc2dd5..1e852d90 100644
--- a/NEWS
+++ b/NEWS
@@ -47,6 +47,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 cdfbefa2..e548bbc0 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>})
@@ -300,7 +301,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
@@ -423,6 +424,7 @@
 (define enable-specialization #f)
 (define static-extensions #f)
 (define emit-link-file #f)
+(define types-output-file #f) ; #t | <filename>
 
 ;;; Other global variables:
 
@@ -1721,6 +1723,12 @@
 			 (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)
diff --git a/manual/Types b/manual/Types
index 921ec65d..da9c6a48 100644
--- a/manual/Types
+++ b/manual/Types
@@ -257,7 +257,7 @@ definitions in an internal format to {{FILENAME}}.
 
 {{-consult-types-file FILENAME}} loads and registers the type-information
 in {{FILENAME}} which should be a file generated though a previous use
-of {{-emit-types-file}}.
+of {{-emit-types-file}} compiler option or {{emit-types-file}} declaration.
 
 If library code is used with {{import}}
 and a {{.types}} file of the same name exists in the