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

move (picrin record-primitive) to (picrin record)

This commit is contained in:
Yuito Murase 2014-08-04 07:38:27 +09:00
parent 9e9666999e
commit 8934c99ac2
2 changed files with 63 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

130
piclib/scheme/base.scm
View File

@ -732,77 +732,71 @@
(export parameterize make-parameter) (export parameterize make-parameter)
;;; Record Type ;; 5.5 Recored-type definitions
(define-library (picrin record)
(import (scheme base)
(picrin macro)
(picrin record-primitive))
(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)
(let ((rectype (make-record #t)))
(record-set! rectype #t 'name name)
rectype))
(define-syntax define-record-constructor
(ir-macro-transformer
(lambda (form inject compare?)
(let ((rectype (cadr form))
(name (caddr form))
(fields (cdddr form)))
`(define (,name ,@fields)
(let ((record (make-record ,rectype)))
,@(map (lambda (field)
`(record-set! record ,rectype ',field ,field))
fields)
record))))))
(define-syntax define-record-predicate
(ir-macro-transformer
(lambda (form inject compare?)
(let ((rectype (cadr form))
(name (caddr form)))
`(define (,name obj)
(record-of? obj ,rectype))))))
(define-syntax define-record-field
(ir-macro-transformer
(lambda (form inject compare?)
(let ((rectype (cadr form))
(field-name (caddr form))
(accessor (cadddr form))
(modifier? (cddddr form)))
(if (null? modifier?)
`(define (,accessor record)
(record-ref record ,rectype ',field-name))
`(begin
(define (,accessor record)
(record-ref record ,rectype ',field-name))
(define (,(car modifier?) record val)
(record-set! record ,rectype ',field-name val))))))))
(define-syntax define-record-type
(ir-macro-transformer
(lambda (form inject compare?)
(let ((name (cadr form))
(constructor (caddr form))
(pred (cadddr form))
(fields (cddddr form)))
`(begin
(define ,name (make-record-type ',name))
(define-record-constructor ,name ,@constructor)
(define-record-predicate ,name ,pred)
,@(map (lambda (field) `(define-record-field ,name ,@field))
fields))))))
(export define-record-type))
(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)
(let ((rectype (make-record #t)))
(record-set! rectype #t 'name name)
rectype))
(define-syntax define-record-constructor
(ir-macro-transformer
(lambda (form inject compare?)
(let ((rectype (cadr form))
(name (caddr form))
(fields (cdddr form)))
`(define (,name ,@fields)
(let ((record (make-record ,rectype)))
,@(map (lambda (field)
`(record-set! record ,rectype ',field ,field))
fields)
record))))))
(define-syntax define-record-predicate
(ir-macro-transformer
(lambda (form inject compare?)
(let ((rectype (cadr form))
(name (caddr form)))
`(define (,name obj)
(record-of? obj ,rectype))))))
(define-syntax define-record-field
(ir-macro-transformer
(lambda (form inject compare?)
(let ((rectype (cadr form))
(field-name (caddr form))
(accessor (cadddr form))
(modifier? (cddddr form)))
(if (null? modifier?)
`(define (,accessor record)
(record-ref record ,rectype ',field-name))
`(begin
(define (,accessor record)
(record-ref record ,rectype ',field-name))
(define (,(car modifier?) record val)
(record-set! record ,rectype ',field-name val))))))))
(define-syntax define-record-type
(ir-macro-transformer
(lambda (form inject compare?)
(let ((name (cadr form))
(constructor (caddr form))
(pred (cadddr form))
(fields (cddddr form)))
`(begin
(define ,name (make-record-type ',name))
(define-record-constructor ,name ,@constructor)
(define-record-predicate ,name ,pred)
,@(map (lambda (field) `(define-record-field ,name ,@field))
fields))))))
(export define-record-type) (export define-record-type)

2
src/record.c
View File

@ -106,7 +106,7 @@ pic_record_record_set(pic_state *pic)
void void
pic_init_record(pic_state *pic) pic_init_record(pic_state *pic)
{ {
pic_deflibrary (pic, "(picrin record-primitive)") { pic_deflibrary (pic, "(picrin record)") {
pic_defun(pic, "make-record", pic_record_record); pic_defun(pic, "make-record", pic_record_record);
pic_defun(pic, "record-of?", pic_record_record_of); pic_defun(pic, "record-of?", pic_record_record_of);
pic_defun(pic, "record-ref", pic_record_record_ref); pic_defun(pic, "record-ref", pic_record_record_ref);