mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
provide a nicer binary type interface
This commit is contained in:
parent
ae76cc7149
commit
d482daa106
3 changed files with 8 additions and 7 deletions
|
@ -31,7 +31,7 @@
|
||||||
(b ...) (f ...))
|
(b ...) (f ...))
|
||||||
(defrec ((block: . fields) . rest) n m p r w
|
(defrec ((block: . fields) . rest) n m p r w
|
||||||
(b ...
|
(b ...
|
||||||
(field read-tmp (type read: 'args) write-tmp (type write: 'args) getter))
|
(field read-tmp (type read: args) write-tmp (type write: args) getter))
|
||||||
(f ...
|
(f ...
|
||||||
(field getter . s))))
|
(field getter . s))))
|
||||||
((defrec ((block: (field . x)) . rest) n m p r w b f)
|
((defrec ((block: (field . x)) . rest) n m p r w b f)
|
||||||
|
|
|
@ -7,7 +7,7 @@
|
||||||
((defrec () n m p r w
|
((defrec () n m p r w
|
||||||
((field-tmp field-read field-read-expr field-write field-write-expr field-get) ...)
|
((field-tmp field-read field-read-expr field-write field-write-expr field-get) ...)
|
||||||
((field getter . s) ...)
|
((field getter . s) ...)
|
||||||
((def setter val) ...))
|
(def-setter ...))
|
||||||
(begin
|
(begin
|
||||||
(define-record-type n (m field ...) p
|
(define-record-type n (m field ...) p
|
||||||
(field getter . s) ...)
|
(field getter . s) ...)
|
||||||
|
@ -20,7 +20,7 @@
|
||||||
(let ((field-write field-write-expr) ...)
|
(let ((field-write field-write-expr) ...)
|
||||||
(lambda (x out)
|
(lambda (x out)
|
||||||
(field-write (field-get x) out) ...)))
|
(field-write (field-get x) out) ...)))
|
||||||
(def setter val) ...)
|
def-setter ...)
|
||||||
;; workaround for impls which strip hygiene from top-level defs
|
;; workaround for impls which strip hygiene from top-level defs
|
||||||
;; for some reason, works in chicken but not across libraries
|
;; for some reason, works in chicken but not across libraries
|
||||||
;;
|
;;
|
||||||
|
@ -55,12 +55,12 @@
|
||||||
(b ...) (f ...) (s ...))
|
(b ...) (f ...) (s ...))
|
||||||
(defrec ((block: . fields) . rest) n m p r w
|
(defrec ((block: . fields) . rest) n m p r w
|
||||||
(b ...
|
(b ...
|
||||||
(field read-tmp (type read: 'args) write-tmp (type write: 'args) getter))
|
(field read-tmp (type read: args) write-tmp (type write: args) getter))
|
||||||
(f ...
|
(f ...
|
||||||
(field getter tmp-setter))
|
(field getter tmp-setter))
|
||||||
(s ...
|
(s ...
|
||||||
(define setter
|
(define setter
|
||||||
(let ((pred? (type pred: 'args)))
|
(let ((pred? (type pred: args)))
|
||||||
(lambda (x val)
|
(lambda (x val)
|
||||||
(if (not (pred? val))
|
(if (not (pred? val))
|
||||||
(error "invalid val for" 'field val))
|
(error "invalid val for" 'field val))
|
||||||
|
@ -69,7 +69,7 @@
|
||||||
(b ...) (f ...) s)
|
(b ...) (f ...) s)
|
||||||
(defrec ((block: . fields) . rest) n m p r w
|
(defrec ((block: . fields) . rest) n m p r w
|
||||||
(b ...
|
(b ...
|
||||||
(field read-tmp (type read: 'args) write-tmp (type write: 'args) getter))
|
(field read-tmp (type read: args) write-tmp (type write: args) getter))
|
||||||
(f ...
|
(f ...
|
||||||
(field getter))
|
(field getter))
|
||||||
s))
|
s))
|
||||||
|
|
|
@ -16,7 +16,8 @@
|
||||||
;; auxiliary syntax
|
;; auxiliary syntax
|
||||||
make: pred: read: write: block:
|
make: pred: read: write: block:
|
||||||
;; indirect exports
|
;; indirect exports
|
||||||
define-binary-type defrec define-auxiliary-syntax)
|
define-binary-type defrec define-auxiliary-syntax
|
||||||
|
syntax-let-optionals*)
|
||||||
(include "binary-types.scm")
|
(include "binary-types.scm")
|
||||||
(cond-expand
|
(cond-expand
|
||||||
(chicken
|
(chicken
|
||||||
|
|
Loading…
Add table
Reference in a new issue