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

refactor record type bootstrap

This commit is contained in:
Yuichi Nishiwaki 2014-08-06 22:15:35 +09:00
parent 0eecddb5da
commit 8a5a3e6b97
1 changed files with 23 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
piclib/scheme/base.scm
View File

@ -746,16 +746,10 @@
;; 5.5 Recored-type definitions ;; 5.5 Recored-type definitions
(import (picrin record)) (import (picrin record)
(scheme write))
(define <record-type> #t) ; bootstrap (define ((default-record-writer ctor) obj)
(import (scheme write))
(define (make-record-type name ctor)
(let ((rectype (make-record <record-type>)))
(record-set! rectype 'name name)
(record-set! rectype 'writer (lambda (obj)
(let ((port (open-output-string))) (let ((port (open-output-string)))
(display "#.(" port) (display "#.(" port)
(display (car ctor) port) (display (car ctor) port)
@ -765,14 +759,22 @@
(write (record-ref obj field) port)) (write (record-ref obj field) port))
(cdr ctor)) (cdr ctor))
(display ")" port) (display ")" port)
(get-output-string port)))) (get-output-string port)))
(define ((boot-make-record-type <meta-type>) name ctor)
(let ((rectype (make-record <meta-type>)))
(record-set! rectype 'name name)
(record-set! rectype 'writer (default-record-writer ctor))
rectype)) rectype))
(set! <record-type> (define <record-type>
(let ((<record-type> (make-record-type '<record-type> '(name writer)))) (let ((<record-type>
((boot-make-record-type #t) 'record-type '(record-type name writer))))
(record-set! <record-type> '@@type <record-type>) (record-set! <record-type> '@@type <record-type>)
<record-type>)) <record-type>))
(define make-record-type (boot-make-record-type <record-type>))
(define-syntax define-record-constructor (define-syntax define-record-constructor
(ir-macro-transformer (ir-macro-transformer
(lambda (form inject compare?) (lambda (form inject compare?)