mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-21 14:49:18 +02:00
merge
This commit is contained in:
commit
078c591cbc
3 changed files with 90 additions and 88 deletions
|
@ -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))))))
|
||||||
|
|
||||||
|
|
|
@ -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))))))))))))))
|
||||||
|
|
|
@ -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)))))))))))))))
|
||||||
))))))
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue