records: Move 'make-syntactic-constructor' to the top level.
* guix/records.scm (make-syntactic-constructor): New procedure, formerly nested in 'define-record-type*'.
This commit is contained in:
parent
9b543456d7
commit
cf4efb394f
|
@ -42,48 +42,11 @@
|
|||
(format #f fmt args ...)
|
||||
form))))
|
||||
|
||||
(define-syntax define-record-type*
|
||||
(lambda (s)
|
||||
"Define the given record type such that an additional \"syntactic
|
||||
constructor\" is defined, which allows instances to be constructed with named
|
||||
field initializers, à la SRFI-35, as well as default values. An example use
|
||||
may look like this:
|
||||
|
||||
(define-record-type* <thing> thing make-thing
|
||||
thing?
|
||||
(name thing-name (default \"chbouib\"))
|
||||
(port thing-port
|
||||
(default (current-output-port)) (thunked)))
|
||||
|
||||
This example defines a macro 'thing' that can be used to instantiate records
|
||||
of this type:
|
||||
|
||||
(thing
|
||||
(name \"foo\")
|
||||
(port (current-error-port)))
|
||||
|
||||
The value of 'name' or 'port' could as well be omitted, in which case the
|
||||
default value specified in the 'define-record-type*' form is used:
|
||||
|
||||
(thing)
|
||||
|
||||
The 'port' field is \"thunked\", meaning that calls like '(thing-port x)' will
|
||||
actually compute the field's value in the current dynamic extent, which is
|
||||
useful when referring to fluids in a field's value.
|
||||
|
||||
It is possible to copy an object 'x' created with 'thing' like this:
|
||||
|
||||
(thing (inherit x) (name \"bar\"))
|
||||
|
||||
This expression returns a new object equal to 'x' except for its 'name'
|
||||
field."
|
||||
|
||||
(define* (make-syntactic-constructor type name ctor fields
|
||||
#:key thunked defaults)
|
||||
"Make the syntactic constructor NAME for TYPE, that calls CTOR, and
|
||||
expects all of FIELDS to be initialized. DEFAULTS is the list of
|
||||
FIELD/DEFAULT-VALUE tuples, and THUNKED is the list of identifiers of
|
||||
thunked fields."
|
||||
"Make the syntactic constructor NAME for TYPE, that calls CTOR, and expects
|
||||
all of FIELDS to be initialized. DEFAULTS is the list of FIELD/DEFAULT-VALUE
|
||||
tuples, and THUNKED is the list of identifiers of thunked fields."
|
||||
(with-syntax ((type type)
|
||||
(name name)
|
||||
(ctor ctor)
|
||||
|
@ -92,9 +55,8 @@ thunked fields."
|
|||
#`(define-syntax name
|
||||
(lambda (s)
|
||||
(define (record-inheritance orig-record field+value)
|
||||
;; Produce code that returns a record identical to
|
||||
;; ORIG-RECORD, except that values for the FIELD+VALUE alist
|
||||
;; prevail.
|
||||
;; Produce code that returns a record identical to ORIG-RECORD,
|
||||
;; except that values for the FIELD+VALUE alist prevail.
|
||||
(define (field-inherited-value f)
|
||||
(and=> (find (lambda (x)
|
||||
(eq? f (car (syntax->datum x))))
|
||||
|
@ -102,8 +64,7 @@ thunked fields."
|
|||
car))
|
||||
|
||||
;; Make sure there are no unknown field names.
|
||||
(let* ((fields (map (compose car syntax->datum)
|
||||
field+value))
|
||||
(let* ((fields (map (compose car syntax->datum) field+value))
|
||||
(unexpected (lset-difference eq? fields 'expected)))
|
||||
(when (pair? unexpected)
|
||||
(record-error 'name s "extraneous field initializers ~a"
|
||||
|
@ -149,8 +110,7 @@ thunked fields."
|
|||
#'((field value) (... ...)))
|
||||
car)
|
||||
(let ((value
|
||||
(car (assoc-ref dflt
|
||||
(syntax->datum f)))))
|
||||
(car (assoc-ref dflt (syntax->datum f)))))
|
||||
(if (thunked-field? f)
|
||||
#`(lambda () #,value)
|
||||
value))))
|
||||
|
@ -171,6 +131,42 @@ thunked fields."
|
|||
(lset-difference eq? 'expected
|
||||
fields))))))))))))
|
||||
|
||||
(define-syntax define-record-type*
|
||||
(lambda (s)
|
||||
"Define the given record type such that an additional \"syntactic
|
||||
constructor\" is defined, which allows instances to be constructed with named
|
||||
field initializers, à la SRFI-35, as well as default values. An example use
|
||||
may look like this:
|
||||
|
||||
(define-record-type* <thing> thing make-thing
|
||||
thing?
|
||||
(name thing-name (default \"chbouib\"))
|
||||
(port thing-port
|
||||
(default (current-output-port)) (thunked)))
|
||||
|
||||
This example defines a macro 'thing' that can be used to instantiate records
|
||||
of this type:
|
||||
|
||||
(thing
|
||||
(name \"foo\")
|
||||
(port (current-error-port)))
|
||||
|
||||
The value of 'name' or 'port' could as well be omitted, in which case the
|
||||
default value specified in the 'define-record-type*' form is used:
|
||||
|
||||
(thing)
|
||||
|
||||
The 'port' field is \"thunked\", meaning that calls like '(thing-port x)' will
|
||||
actually compute the field's value in the current dynamic extent, which is
|
||||
useful when referring to fluids in a field's value.
|
||||
|
||||
It is possible to copy an object 'x' created with 'thing' like this:
|
||||
|
||||
(thing (inherit x) (name \"bar\"))
|
||||
|
||||
This expression returns a new object equal to 'x' except for its 'name'
|
||||
field."
|
||||
|
||||
(define (field-default-value s)
|
||||
(syntax-case s (default)
|
||||
((field (default val) _ ...)
|
||||
|
|
Loading…
Reference in New Issue