From 9804c7040873bf8fd7820fa359a3a9e7f658a53d Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 25 Mar 2016 10:35:19 -0700 Subject: [PATCH] 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. --- src/cref/toplev.scm | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/src/cref/toplev.scm b/src/cref/toplev.scm index 39a47666c..5d76d7997 100644 --- 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 -- 2.25.1