Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-21 14:49:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

merge

Browse source
This commit is contained in:
Alex Shinn 2010-09-17 01:48:51 +00:00
commit 078c591cbc
3 changed files with 90 additions and 88 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lib/init.scm
View file

@ -525,6 +525,8 @@
;; I/O utils
(define (port? x) (or (input-port? x) (output-port? x)))
(define (char-ready? . o)
(not (eof-object? (peek-char (if (pair? o) (car o) (current-input-port))))))

15
lib/srfi/9.scm
View file

@ -17,7 +17,7 @@
(_type_slot_offset (rename 'type-slot-offset)))
`(,(rename 'begin)
;; type
(,_define ,name (,_register ,name-str ,parent ',fields))
(,_define ,name (,_register ,name-str ,parent ',(map car fields)))
;; predicate
(,_define ,pred (,(rename 'make-type-predicate)
,(symbol->string (identifier->symbol pred))
@ -25,21 +25,21 @@
;; fields
,@(map (lambda (f)
(and (pair? f) (pair? (cdr f))
`(,_define ,(cadar ls)
`(,_define ,(cadr f)
(,(rename 'make-getter)
,(symbol->string
(identifier->symbol (cadr f)))
,name
(,_type_slot_offset ,name ,(car f))))))
(,_type_slot_offset ,name ',(car f))))))
fields)
,@(map (lambda (f)
(and (pair? f) (pair? (cdr f)) (pair? (cddr f))
`(,_define ,(caddar ls)
`(,_define ,(caddr f)
(,(rename 'make-setter)
,(symbol->string
(identifier->symbol (caddr f)))
,name
(,_type_slot_offset ,name ,(car f))))))
(,_type_slot_offset ,name ',(car f))))))
fields)
;; constructor
(,_define ,make
@ -60,7 +60,8 @@
(error "unknown record field in constructor" (car ls)))
((pair? (cddr field))
(lp (cdr ls)
(cons (list (caddr field) 'res (car ls)) sets)))
(cons `(,(caddr field) res ,(car ls)) sets)))
(else
(lp (cdr ls)
(cons (list _slot-set! 'res (list 'quote (car ls)) (car ls)) sets))))))))))))))
(cons `(,_slot-set! ,name res (,_type_slot_offset ,name ',(car ls)) ,(car ls))
sets))))))))))))))

3
lib/srfi/99/records/syntactic.scm
View file

@ -105,5 +105,4 @@
a))
(else
(,_slot-set! ,name res (,_type_slot_offset ,name (car p)) (car a))
(lp (cdr a) (cdr p)))))))))
))))))
(lp (cdr a) (cdr p)))))))))))))))