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

Include additional info with record instances

Browse source
This commit is contained in:
Justin Ethier 2016-02-02 22:12:18 -05:00
parent 770dba7bdb
commit 4540c11a48
2 changed files with 34 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
kons.scm
View file

@ -4,28 +4,28 @@
(srfi 9) (srfi 9)
) )
;((lambda () ;; TODO: seems begins are not spliced when part of an applied lambda??
; ((lambda ()
;(define-record-type <pare>
; (kons x y)
; pare?
; (x kar) ;TODO: set-kar!)
; (y kdr))
;
;(write
; (list
; (pare? (kons 1 2)) ; =. #t
; (pare? (cons 1 2)) ; =. #f
;; (kar (kons 1 2)) ; =. 1
;; (kdr (kons 1 2)) ; =. 2
;; (let ((k (kons 1 2)))
;; (set-kar! k 3)
;; (kar k)) ;=. 3
;))
;))
(define <pare> (register-simple-type <pare> #f (quote (x y)))) (define-record-type <pare>
;(define pare? vector?) ;(make-type-predicate pare? <pare>)) (kons x y)
pare?
(x kar) ;TODO: set-kar!)
(y kdr))
(write
(list
(pare? (kons 1 2)) ; =. #t
(pare? (cons 1 2)) ; =. #f
; (kar (kons 1 2)) ; =. 1
; (kdr (kons 1 2)) ; =. 2
; (let ((k (kons 1 2)))
; (set-kar! k 3)
; (kar k)) ;=. 3
))
;(define <pare> (register-simple-type <pare> #f (quote (x y))))
;(define pare? (make-type-predicate pare? <pare>))
;(define kons ;(define kons
; ((lambda (%make) ; ((lambda (%make)
; (lambda (x y) ; (lambda (x y)
@ -37,10 +37,16 @@
; (make-constructor "kons" <pare>))) ; (make-constructor "kons" <pare>)))
;(write ;(write
; (list ; (list
; (kons 1 2)
; (pare? (kons 1 2)) ; (pare? (kons 1 2))
; (pare? (cons 1 4)) ; (pare? (cons 1 4))
;)) ;))
))
;(((lambda ()
;(define <pare> (register-simple-type <pare> #f (quote (x y))))
;(define pare? (make-type-predicate pare? <pare>))
;(define kons ((lambda (%make) (lambda (x y) ((lambda (res) (slot-set! <pare> res (type-slot-offset <pare> (quote y)) y) (slot-set! <pare> res (type-slot-offset <pare> (quote x)) x) res) (%make)))) (make-constructor "kons" <pare>))) (write (list (pare? (kons 1 2)) (pare? (cons 1 2)))))))
;(define (make-lambda) ;(define (make-lambda)
; (lambda (a b c) (write (+ a b c)))) ; (lambda (a b c) (write (+ a b c))))
;(define test (make-lambda)) ;(define test (make-lambda))

9
srfi/9.sld
View file

@ -29,14 +29,19 @@
(define (make-constructor make name) (define (make-constructor make name)
(lambda () (lambda ()
(let* ((field-tags (vector-ref name 2)) (let* ((field-tags (vector-ref name 2))
(new (make-vector (length field-tags) #f))) (field-values (make-vector (length field-tags) #f))
(new (make-vector 3 #f))
)
(vector-set! new 0 record-marker)
(vector-set! new 1 name)
(vector-set! new 2 field-values)
new))) new)))
(define (type-slot-offset name sym) (define (type-slot-offset name sym)
(let ((field-tags (vector-ref name 2))) (let ((field-tags (vector-ref name 2)))
(list-index2 sym field-tags))) (list-index2 sym field-tags)))
(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! vec idx val))) (vector-set! (vector-ref vec 2) idx val)))
(define-syntax define-record-type (define-syntax define-record-type
(er-macro-transformer (er-macro-transformer