Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-15 00:37: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> (define-record-type <pare>
(kons x y) (kons x y)
pare? pare?
(x kar) ;TODO: set-kar!) (x kar set-kar!)
(y kdr)) (y kdr))
(write (write

52
srfi/9.sld
View file

@ -8,6 +8,8 @@
register-simple-type register-simple-type
make-type-predicate make-type-predicate
make-constructor make-constructor
make-getter
make-setter
slot-set! slot-set!
type-slot-offset type-slot-offset
) )
@ -42,6 +44,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 (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 (define-syntax define-record-type
(er-macro-transformer (er-macro-transformer
@ -74,29 +80,29 @@
(,_define ,pred (,(rename 'make-type-predicate) (,_define ,pred (,(rename 'make-type-predicate)
,pred ;(symbol->string pred) ;(identifier->symbol pred)) ,pred ;(symbol->string pred) ;(identifier->symbol pred))
,name)) ,name))
; ;; fields ;; fields
; ,@(map (lambda (f) ,@(map (lambda (f)
; (and (pair? f) (pair? (cdr f)) (and (pair? f) (pair? (cdr f))
; `(,_define ,(cadr f) `(,_define ,(cadr f)
; (,(rename 'make-getter) (,(rename 'make-getter)
; ,(symbol->string ,(symbol->string
; (cadr f) (cadr f)
; ;(identifier->symbol (cadr f)) ;(identifier->symbol (cadr f))
; ) )
; ,name ,name
; (,_type_slot_offset ,name ',(car f)))))) (,_type_slot_offset ,name ',(car f))))))
; fields) fields)
; ,@(map (lambda (f) ,@(map (lambda (f)
; (and (pair? f) (pair? (cdr f)) (pair? (cddr f)) (and (pair? f) (pair? (cdr f)) (pair? (cddr f))
; `(,_define ,(car (cddr f)) `(,_define ,(car (cddr f))
; (,(rename 'make-setter) (,(rename 'make-setter)
; ,(symbol->string ,(symbol->string
; (car (cddr f)) (car (cddr f))
; ;(identifier->symbol (car (cddr f))) ;(identifier->symbol (car (cddr f)))
; ) )
; ,name ,name
; (,_type_slot_offset ,name ',(car f)))))) (,_type_slot_offset ,name ',(car f))))))
; fields) fields)
;; constructor ;; constructor
(,_define ,make (,_define ,make
,(let lp ((ls make-fields) (sets '())) ,(let lp ((ls make-fields) (sets '()))