Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-14 16:27:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP

Browse source
This commit is contained in:
Justin Ethier 2016-02-02 23:16:58 -05:00
parent 4540c11a48
commit 449fc1a76e
2 changed files with 30 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
kons.scm
View file

@ -10,7 +10,7 @@
(define-record-type <pare>
(kons x y)
pare?
(x kar) ;TODO: set-kar!)
(x kar set-kar!)
(y kdr))
(write

52
srfi/9.sld
View file

@ -8,6 +8,8 @@
register-simple-type
make-type-predicate
make-constructor
make-getter
make-setter
slot-set!
type-slot-offset
)
@ -42,6 +44,10 @@
(define (slot-set! name obj idx val)
(let ((vec obj)) ;; TODO: get actual slots from obj
(vector-set! (vector-ref vec 2) idx val)))
(define (make-getter sym name idx)
'TODO) ;; return the getter function
(define (make-setter sym name idx)
'TODO) ;; return the setter function
(define-syntax define-record-type
(er-macro-transformer
@ -74,29 +80,29 @@
(,_define ,pred (,(rename 'make-type-predicate)
,pred ;(symbol->string pred) ;(identifier->symbol pred))
,name))
; ;; fields
; ,@(map (lambda (f)
; (and (pair? f) (pair? (cdr f))
; `(,_define ,(cadr f)
; (,(rename 'make-getter)
; ,(symbol->string
; (cadr f)
; ;(identifier->symbol (cadr f))
; )
; ,name
; (,_type_slot_offset ,name ',(car f))))))
; fields)
; ,@(map (lambda (f)
; (and (pair? f) (pair? (cdr f)) (pair? (cddr f))
; `(,_define ,(car (cddr f))
; (,(rename 'make-setter)
; ,(symbol->string
; (car (cddr f))
; ;(identifier->symbol (car (cddr f)))
; )
; ,name
; (,_type_slot_offset ,name ',(car f))))))
; fields)
;; fields
,@(map (lambda (f)
(and (pair? f) (pair? (cdr f))
`(,_define ,(cadr f)
(,(rename 'make-getter)
,(symbol->string
(cadr f)
;(identifier->symbol (cadr f))
)
,name
(,_type_slot_offset ,name ',(car f))))))
fields)
,@(map (lambda (f)
(and (pair? f) (pair? (cdr f)) (pair? (cddr f))
`(,_define ,(car (cddr f))
(,(rename 'make-setter)
,(symbol->string
(car (cddr f))
;(identifier->symbol (car (cddr f)))
)
,name
(,_type_slot_offset ,name ',(car f))))))
fields)
;; constructor
(,_define ,make
,(let lp ((ls make-fields) (sets '()))