cref/generate-trivial-constructor: Add optional parameter OS-TYPE.

Plugin installs do not include package descriptions for other OSes.
This causes cref/generate-trivial-constructor to emit warnings.  The
argument #F for OS-TYPE now causes it to punt other OSes.

diff --git a/src/cref/toplev.scm b/src/cref/toplev.scm
index 39a47666cc712db075e211fe214590f9495c41d9..5d76d79974ea3daff494cad5358dcd624d3503f5 100644 (file)
--- a/src/cref/toplev.scm
+++ b/src/cref/toplev.scm
@@ -42,15 +42,23 @@ USA.
            ((memq os-type os-types) (do-type os-type))
            (else (error:bad-range-argument os-type #f))))))
 
-(define (cref/generate-trivial-constructor filename)
-  (let ((pathname (merge-pathnames filename)))
-    (for-each (lambda (os-type)
-               (write-external-descriptions
-                pathname
-                (read-package-model pathname os-type)
-                #f
-                os-type))
-             os-types)))
+(define (cref/generate-trivial-constructor filename #!optional os-type)
+  (let* ((pathname (merge-pathnames filename))
+        (do-type
+         (lambda (os-type)
+           (write-external-descriptions
+            pathname
+            (read-package-model pathname os-type)
+            #f
+            os-type))))
+    (cond ((or (default-object? os-type)
+              (eq? os-type 'ALL))
+          (for-each do-type os-types))
+         ((eq? os-type #f)
+          (do-type microcode-id/operating-system))
+         ((memq os-type os-types)
+          (do-type os-type))
+         (else (error:bad-range-argument os-type #f)))))
 
 (define (cref/package-files filename os-type)
   (append-map package/files