nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

records: Move 'make-syntactic-constructor' to the top level. 

* guix/records.scm (make-syntactic-constructor): New procedure, formerly
  nested in 'define-record-type*'.
master
Ludovic Courtès 2015-01-19 22:30:55 +01:00
parent 9b543456d7
commit cf4efb394f
1 changed files with 89 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
guix/records.scm
View File

@ -42,48 +42,11 @@
(format #f fmt args ...) (format #f fmt args ...)
form)))) form))))
(define-syntax define-record-type* (define* (make-syntactic-constructor type name ctor fields
(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) #:key thunked defaults)
"Make the syntactic constructor NAME for TYPE, that calls CTOR, and "Make the syntactic constructor NAME for TYPE, that calls CTOR, and expects
expects all of FIELDS to be initialized. DEFAULTS is the list of all of FIELDS to be initialized. DEFAULTS is the list of FIELD/DEFAULT-VALUE
FIELD/DEFAULT-VALUE tuples, and THUNKED is the list of identifiers of tuples, and THUNKED is the list of identifiers of thunked fields."
thunked fields."
(with-syntax ((type type) (with-syntax ((type type)
(name name) (name name)
(ctor ctor) (ctor ctor)
@ -92,9 +55,8 @@ thunked fields."
#`(define-syntax name #`(define-syntax name
(lambda (s) (lambda (s)
(define (record-inheritance orig-record field+value) (define (record-inheritance orig-record field+value)
;; Produce code that returns a record identical to ;; Produce code that returns a record identical to ORIG-RECORD,
;; ORIG-RECORD, except that values for the FIELD+VALUE alist ;; except that values for the FIELD+VALUE alist prevail.
;; prevail.
(define (field-inherited-value f) (define (field-inherited-value f)
(and=> (find (lambda (x) (and=> (find (lambda (x)
(eq? f (car (syntax->datum x)))) (eq? f (car (syntax->datum x))))
@ -102,8 +64,7 @@ thunked fields."
car)) car))
;; Make sure there are no unknown field names. ;; Make sure there are no unknown field names.
(let* ((fields (map (compose car syntax->datum) (let* ((fields (map (compose car syntax->datum) field+value))
field+value))
(unexpected (lset-difference eq? fields 'expected))) (unexpected (lset-difference eq? fields 'expected)))
(when (pair? unexpected) (when (pair? unexpected)
(record-error 'name s "extraneous field initializers ~a" (record-error 'name s "extraneous field initializers ~a"
@ -149,8 +110,7 @@ thunked fields."
#'((field value) (... ...))) #'((field value) (... ...)))
car) car)
(let ((value (let ((value
(car (assoc-ref dflt (car (assoc-ref dflt (syntax->datum f)))))
(syntax->datum f)))))
(if (thunked-field? f) (if (thunked-field? f)
#`(lambda () #,value) #`(lambda () #,value)
value)))) value))))
@ -171,6 +131,42 @@ thunked fields."
(lset-difference eq? 'expected (lset-difference eq? 'expected
fields)))))))))))) 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) (define (field-default-value s)
(syntax-case s (default) (syntax-case s (default)
((field (default val) _ ...) ((field (default val) _ ...)