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 ;; I/O utils
(define (port? x) (or (input-port? x) (output-port? x)))
(define (char-ready? . o) (define (char-ready? . o)
(not (eof-object? (peek-char (if (pair? o) (car o) (current-input-port)))))) (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))) (_type_slot_offset (rename 'type-slot-offset)))
`(,(rename 'begin) `(,(rename 'begin)
;; type ;; type
(,_define ,name (,_register ,name-str ,parent ',fields)) (,_define ,name (,_register ,name-str ,parent ',(map car fields)))
;; predicate ;; predicate
(,_define ,pred (,(rename 'make-type-predicate) (,_define ,pred (,(rename 'make-type-predicate)
,(symbol->string (identifier->symbol pred)) ,(symbol->string (identifier->symbol pred))
@ -25,21 +25,21 @@
;; fields ;; fields
,@(map (lambda (f) ,@(map (lambda (f)
(and (pair? f) (pair? (cdr f)) (and (pair? f) (pair? (cdr f))
`(,_define ,(cadar ls) `(,_define ,(cadr f)
(,(rename 'make-getter) (,(rename 'make-getter)
,(symbol->string ,(symbol->string
(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 ,(caddar ls) `(,_define ,(caddr f)
(,(rename 'make-setter) (,(rename 'make-setter)
,(symbol->string ,(symbol->string
(identifier->symbol (caddr f))) (identifier->symbol (caddr f)))
,name ,name
(,_type_slot_offset ,name ,(car f)))))) (,_type_slot_offset ,name ',(car f))))))
fields) fields)
;; constructor ;; constructor
(,_define ,make (,_define ,make
@ -60,7 +60,8 @@
(error "unknown record field in constructor" (car ls))) (error "unknown record field in constructor" (car ls)))
((pair? (cddr field)) ((pair? (cddr field))
(lp (cdr ls) (lp (cdr ls)
(cons (list (caddr field) 'res (car ls)) sets))) (cons `(,(caddr field) res ,(car ls)) sets)))
(else (else
(lp (cdr ls) (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)) a))
(else (else
(,_slot-set! ,name res (,_type_slot_offset ,name (car p)) (car a)) (,_slot-set! ,name res (,_type_slot_offset ,name (car p)) (car a))
(lp (cdr a) (cdr p))))))))) (lp (cdr a) (cdr p)))))))))))))))
))))))