diff --git a/src/ikarus.boot b/src/ikarus.boot index 18330df..13584af 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/libcompile.ss b/src/libcompile.ss index d46c4dc..c00c65d 100644 --- a/src/libcompile.ss +++ b/src/libcompile.ss @@ -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)] diff --git a/src/libsyntax.ss b/src/libsyntax.ss index 4a6c339..e264f37 100644 --- a/src/libsyntax.ss +++ b/src/libsyntax.ss @@ -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))))) diff --git a/src/makefile.ss b/src/makefile.ss index b584c3b..0345d3a 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -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