* syntax-objects are now non-generative records

This commit is contained in:
Abdulaziz Ghuloum 2007-05-01 17:25:43 -04:00
parent e1bfd0f31f
commit 2fae44c304
4 changed files with 36 additions and 30 deletions

Binary file not shown.

View File

@ -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)]

View File

@ -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)))))

View File

@ -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