Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-09 22:17:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP refactoring record marker

Browse source 
Idea here is to use a new record marker that is guaranteed to be unique and that will be faster to compare against in the C runtime.
This commit is contained in:
Justin Ethier 2020-12-21 21:50:07 -05:00
parent bf985615bc
commit cc3c8f5bac
1 changed files with 11 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
scheme/base.sld
View file

@ -1973,14 +1973,17 @@
(guard-aux reraise clause1 clause2 ...))))) (guard-aux reraise clause1 clause2 ...)))))
;; Record-type definitions ;; Record-type definitions
(define record-marker (list 'record-marker)) (define record-marker (record-marker2))
(define (register-simple-type name parent field-tags) (define (register-simple-type name parent field-tags)
(vector record-marker name field-tags)) (vector record-marker name field-tags))
(define (make-type-predicate pred name) (define (make-type-predicate pred name)
(lambda (obj) (lambda (obj)
(and (vector? obj) (and (vector? obj)
(= (vector-length obj) 3) (= (vector-length obj) 3)
(equal? (vector-ref obj 0) record-marker) (or
(equal? (vector-ref obj 0) record-marker)
(equal? (vector-ref obj 0) (list 'record-marker))
)
(equal? (vector-ref obj 1) name)))) (equal? (vector-ref obj 1) name))))
(define (make-constructor make name) (define (make-constructor make name)
(lambda args (lambda args
@ -2029,7 +2032,11 @@
(define (record? obj) (define (record? obj)
(and (vector? obj) (and (vector? obj)
(> (vector-length obj) 0) (> (vector-length obj) 0)
(equal? record-marker (vector-ref obj 0)))) (or
(equal? record-marker (vector-ref obj 0))
(equal? (list 'record-marker) (vector-ref obj 0))
)
))
(define (is-a? obj rtype) (define (is-a? obj rtype)
(and (record? obj) (and (record? obj)
@ -2099,7 +2106,7 @@
(,_define ,make (,_define ,make
(,_lambda ,make-fields (,_lambda ,make-fields
(,(rename 'vector) (,(rename 'vector)
',record-marker (record-marker2)
(quote ,name) (quote ,name)
(,(rename 'vector) (,(rename 'vector)
,@make-fields)))) ,@make-fields))))