Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-24 20:45:06 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Record type enhancements

Browse source
This commit is contained in:
Justin Ethier 2018-01-31 19:08:47 -05:00
parent 070ea54ab1
commit aafe5f0d68
1 changed files with 12 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
scheme/base.sld
View file

@ -19,11 +19,13 @@
;; Record types ;; Record types
define-record-type define-record-type
record? record?
is-a?
register-simple-type register-simple-type
make-type-predicate make-type-predicate
make-constructor make-constructor
make-getter make-getter
make-setter make-setter
slot-ref
slot-set! slot-set!
type-slot-offset type-slot-offset
;; END records ;; END records
@ -1803,6 +1805,10 @@
(define (slot-set! name obj idx val) (define (slot-set! name obj idx val)
(let ((vec obj)) ;; TODO: get actual slots from obj (let ((vec obj)) ;; TODO: get actual slots from obj
(vector-set! (vector-ref vec 2) idx val))) (vector-set! (vector-ref vec 2) idx val)))
(define (slot-ref name obj field)
;; TODO: type check
;; TODO: support field as number or symbol
(vector-ref (vector-ref obj 2) field))
(define (make-getter sym name idx) (define (make-getter sym name idx)
(lambda (obj) (lambda (obj)
(vector-ref (vector-ref obj 2) idx))) (vector-ref (vector-ref obj 2) idx)))
@ -1826,6 +1832,11 @@
(> (vector-length obj) 0) (> (vector-length obj) 0)
(equal? record-marker (vector-ref obj 0)))) (equal? record-marker (vector-ref obj 0))))
(define (is-a? obj rtype)
(and (record? obj)
(record? rtype)
(equal? (vector-ref obj 1) rtype)))
(define-syntax define-record-type (define-syntax define-record-type
(er-macro-transformer (er-macro-transformer
(lambda (expr rename compare) (lambda (expr rename compare)
@ -1850,7 +1861,7 @@
`(,(rename 'begin) `(,(rename 'begin)
;; type ;; type
(,_define ,name (,_register (,_define ,name (,_register
,name ;,name-str ,name-str
,parent ,parent
',(map car fields))) ',(map car fields)))
;; predicate ;; predicate