* syntax-objects are now non-generative records
This commit is contained in:
parent
e1bfd0f31f
commit
2fae44c304
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -28,7 +28,7 @@
|
|||
#'(i . i*))]))
|
||||
(define (generate-body ctxt cls*)
|
||||
(syntax-case cls* (else)
|
||||
[() (with-syntax ([x x]) #'(error #f "unmatched ~s in ~s" v #'x))]
|
||||
[() (with-syntax ([x x]) #'(error #f "unmatched ~s in ~s" v 'x))]
|
||||
[([else b b* ...]) #'(begin b b* ...)]
|
||||
[([(rec-name rec-field* ...) b b* ...] . rest) (identifier? #'rec-name)
|
||||
(with-syntax ([altern (generate-body ctxt #'rest)]
|
||||
|
|
|
@ -112,32 +112,8 @@
|
|||
(if (rib? x)
|
||||
(vector-ref x 3)
|
||||
(error 'rib-label* "~s is not a rib" x))))
|
||||
#;(module (make-stx stx? stx-expr stx-mark* stx-subst*)
|
||||
(define-record stx (expr mark* subst*)))
|
||||
(module (make-stx stx? stx-expr stx-mark* stx-subst*)
|
||||
(define make-stx
|
||||
(lambda (e m* s*)
|
||||
(vector 'stx e m* s*)))
|
||||
(define stx?
|
||||
(lambda (x)
|
||||
(and (vector? x)
|
||||
(= (vector-length x) 4)
|
||||
(eq? (vector-ref x 0) 'stx))))
|
||||
(define stx-expr
|
||||
(lambda (x)
|
||||
(if (stx? x)
|
||||
(vector-ref x 1)
|
||||
(error 'stx-expr "~s is not a syntax object" x))))
|
||||
(define stx-mark*
|
||||
(lambda (x)
|
||||
(if (stx? x)
|
||||
(vector-ref x 2)
|
||||
(error 'stx-mark* "~s is not a syntax object" x))))
|
||||
(define stx-subst*
|
||||
(lambda (x)
|
||||
(if (stx? x)
|
||||
(vector-ref x 3)
|
||||
(error 'stx-subst* "~s is not a syntax object" x)))))
|
||||
(define-record stx (expr mark* subst*)))
|
||||
(define datum->stx
|
||||
(lambda (id datum)
|
||||
(make-stx datum (stx-mark* id) (stx-subst* id))))
|
||||
|
@ -2456,3 +2432,33 @@
|
|||
(primitive-set! 'syntax-dispatch syntax-dispatch)
|
||||
(primitive-set! 'chi-top-library library-expander))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
#!eof junk
|
||||
|
||||
(module (make-stx stx? stx-expr stx-mark* stx-subst*)
|
||||
(define make-stx
|
||||
(lambda (e m* s*)
|
||||
(vector 'stx e m* s*)))
|
||||
(define stx?
|
||||
(lambda (x)
|
||||
(and (vector? x)
|
||||
(= (vector-length x) 4)
|
||||
(eq? (vector-ref x 0) 'stx))))
|
||||
(define stx-expr
|
||||
(lambda (x)
|
||||
(if (stx? x)
|
||||
(vector-ref x 1)
|
||||
(error 'stx-expr "~s is not a syntax object" x))))
|
||||
(define stx-mark*
|
||||
(lambda (x)
|
||||
(if (stx? x)
|
||||
(vector-ref x 2)
|
||||
(error 'stx-mark* "~s is not a syntax object" x))))
|
||||
(define stx-subst*
|
||||
(lambda (x)
|
||||
(if (stx? x)
|
||||
(vector-ref x 3)
|
||||
(error 'stx-subst* "~s is not a syntax object" x)))))
|
||||
|
|
|
@ -252,10 +252,10 @@
|
|||
(apply append (map (lambda (x) (expand-library (car x))) ls)))
|
||||
(printf "expanding ...\n")
|
||||
(let ([core* (expand-all scheme-library-files)])
|
||||
; (with-output-to-file "ikarus.pp"
|
||||
; (lambda ()
|
||||
; (for-each pretty-print core*))
|
||||
; 'replace)
|
||||
;(with-output-to-file "ikarus.pp"
|
||||
; (lambda ()
|
||||
; (for-each pretty-print core*))
|
||||
; 'replace)
|
||||
(printf "compiling ...\n")
|
||||
(let ([p (open-output-file "ikarus.boot" 'replace)])
|
||||
(for-each
|
||||
|
|
Loading…
Reference in New Issue