conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

inline cxr functions

This commit is contained in:
Yuichi Nishiwaki 2014-08-05 02:08:14 +09:00
parent bca13f3f44
commit a022941c98
1 changed files with 14 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
piclib/scheme/base.scm
View File

@ -736,11 +736,6 @@
(import (picrin record)) (import (picrin record))
(define (caddr x) (car (cddr x)))
(define (cdddr x) (cdr (cddr x)))
(define (cadddr x) (car (cdddr x)))
(define (cddddr x) (cdr (cdddr x)))
(define (make-record-type name) (define (make-record-type name)
(let ((rectype (make-record #t))) (let ((rectype (make-record #t)))
(record-set! rectype 'name name) (record-set! rectype 'name name)
@ -749,9 +744,9 @@
(define-syntax define-record-constructor (define-syntax define-record-constructor
(ir-macro-transformer (ir-macro-transformer
(lambda (form inject compare?) (lambda (form inject compare?)
(let ((rectype (cadr form)) (let ((rectype (car (cdr form)))
(name (caddr form)) (name (car (cdr (cdr form))))
(fields (cdddr form))) (fields (cdr (cdr (cdr form)))))
`(define (,name ,@fields) `(define (,name ,@fields)
(let ((record (make-record ,rectype))) (let ((record (make-record ,rectype)))
,@(map (lambda (field) ,@(map (lambda (field)
@ -762,8 +757,8 @@
(define-syntax define-record-predicate (define-syntax define-record-predicate
(ir-macro-transformer (ir-macro-transformer
(lambda (form inject compare?) (lambda (form inject compare?)
(let ((rectype (cadr form)) (let ((rectype (car (cdr form)))
(name (caddr form))) (name (car (cdr (cdr form)))))
`(define (,name obj) `(define (,name obj)
(and (record? obj) (and (record? obj)
(record-of? obj ,rectype))))))) (record-of? obj ,rectype)))))))
@ -771,10 +766,10 @@
(define-syntax define-record-field (define-syntax define-record-field
(ir-macro-transformer (ir-macro-transformer
(lambda (form inject compare?) (lambda (form inject compare?)
(let ((pred (cadr form)) (let ((pred (car (cdr form)))
(field-name (caddr form)) (field-name (car (cdr (cdr form))))
(accessor (cadddr form)) (accessor (car (cdr (cdr (cdr form)))))
(modifier? (cddddr form))) (modifier? (cdr (cdr (cdr (cdr form))))))
(if (null? modifier?) (if (null? modifier?)
`(define (,accessor record) `(define (,accessor record)
(if (,pred record) (if (,pred record)
@ -793,13 +788,13 @@
(define-syntax define-record-type (define-syntax define-record-type
(ir-macro-transformer (ir-macro-transformer
(lambda (form inject compare?) (lambda (form inject compare?)
(let ((name (cadr form)) (let ((name (car (cdr form)))
(constructor (caddr form)) (ctor (car (cdr (cdr form))))
(pred (cadddr form)) (pred (car (cdr (cdr (cdr form)))))
(fields (cddddr form))) (fields (cdr (cdr (cdr (cdr form))))))
`(begin `(begin
(define ,name (make-record-type ',name)) (define ,name (make-record-type ',name))
(define-record-constructor ,name ,@constructor) (define-record-constructor ,name ,@ctor)
(define-record-predicate ,name ,pred) (define-record-predicate ,name ,pred)
,@(map (lambda (field) `(define-record-field ,pred ,@field)) ,@(map (lambda (field) `(define-record-field ,pred ,@field))
fields)))))) fields))))))