records: Make a couple of procedures available at expansion time.
* guix/records.scm (current-abi-identifier, abi-check): Wrap in 'eval-when'.
This commit is contained in:
parent
b1059b38b2
commit
9768848af8
@ -63,22 +63,25 @@
|
|||||||
(set-exception-printer! 'record-abi-mismatch-error
|
(set-exception-printer! 'record-abi-mismatch-error
|
||||||
print-record-abi-mismatch-error)
|
print-record-abi-mismatch-error)
|
||||||
|
|
||||||
(define (current-abi-identifier type)
|
(eval-when (expand load eval)
|
||||||
"Return an identifier unhygienically derived from TYPE for use as its
|
;; The procedures below are needed both at run time and at expansion time.
|
||||||
\"current ABI\" variable."
|
|
||||||
(let ((type-name (syntax->datum type)))
|
|
||||||
(datum->syntax
|
|
||||||
type
|
|
||||||
(string->symbol
|
|
||||||
(string-append "% " (symbol->string type-name)
|
|
||||||
" abi-cookie")))))
|
|
||||||
|
|
||||||
(define (abi-check type cookie)
|
(define (current-abi-identifier type)
|
||||||
"Return syntax that checks that the current \"application binary
|
"Return an identifier unhygienically derived from TYPE for use as its
|
||||||
|
\"current ABI\" variable."
|
||||||
|
(let ((type-name (syntax->datum type)))
|
||||||
|
(datum->syntax
|
||||||
|
type
|
||||||
|
(string->symbol
|
||||||
|
(string-append "% " (symbol->string type-name)
|
||||||
|
" abi-cookie")))))
|
||||||
|
|
||||||
|
(define (abi-check type cookie)
|
||||||
|
"Return syntax that checks that the current \"application binary
|
||||||
interface\" (ABI) for TYPE is equal to COOKIE."
|
interface\" (ABI) for TYPE is equal to COOKIE."
|
||||||
(with-syntax ((current-abi (current-abi-identifier type)))
|
(with-syntax ((current-abi (current-abi-identifier type)))
|
||||||
#`(unless (eq? current-abi #,cookie)
|
#`(unless (eq? current-abi #,cookie)
|
||||||
(throw 'record-abi-mismatch-error #,type))))
|
(throw 'record-abi-mismatch-error #,type)))))
|
||||||
|
|
||||||
(define-syntax make-syntactic-constructor
|
(define-syntax make-syntactic-constructor
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
|
Loading…
Reference in New Issue
Block a user