* moved some of the original macros to be true macros
instead of chi procedures.
This commit is contained in:
parent
f62a41cc43
commit
b2b8ba6994
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
265
src/libsyntax.ss
265
src/libsyntax.ss
|
@ -2,7 +2,6 @@
|
||||||
(library (ikarus syntax)
|
(library (ikarus syntax)
|
||||||
(export)
|
(export)
|
||||||
(import (scheme))
|
(import (scheme))
|
||||||
|
|
||||||
(define who 'chi-top-library)
|
(define who 'chi-top-library)
|
||||||
(define noexpand "noexpand")
|
(define noexpand "noexpand")
|
||||||
(define-syntax no-source
|
(define-syntax no-source
|
||||||
|
@ -64,12 +63,6 @@
|
||||||
(define build-letrec
|
(define build-letrec
|
||||||
(lambda (ae vars val-exps body-exp)
|
(lambda (ae vars val-exps body-exp)
|
||||||
(if (null? vars) body-exp `(letrec ,(map list vars val-exps) ,body-exp)))))
|
(if (null? vars) body-exp `(letrec ,(map list vars val-exps) ,body-exp)))))
|
||||||
(define-syntax assert
|
|
||||||
(lambda (x)
|
|
||||||
(syntax-case x ()
|
|
||||||
[(_ name pred* ...)
|
|
||||||
#'(unless (and pred* ...)
|
|
||||||
(error 'name "assertion ~s failed" '(pred* ...)))])))
|
|
||||||
(define top-mark* '(top))
|
(define top-mark* '(top))
|
||||||
(define top-marked?
|
(define top-marked?
|
||||||
(lambda (m*) (memq 'top m*)))
|
(lambda (m*) (memq 'top m*)))
|
||||||
|
@ -119,29 +112,32 @@
|
||||||
(if (rib? x)
|
(if (rib? x)
|
||||||
(vector-ref x 3)
|
(vector-ref x 3)
|
||||||
(error 'rib-label* "~s is not a rib" x))))
|
(error 'rib-label* "~s is not a rib" x))))
|
||||||
(define make-stx
|
#;(module (make-stx stx? stx-expr stx-mark* stx-subst*)
|
||||||
(lambda (e m* s*)
|
(define-record stx (expr mark* subst*)))
|
||||||
(vector 'stx e m* s*)))
|
(module (make-stx stx? stx-expr stx-mark* stx-subst*)
|
||||||
(define stx?
|
(define make-stx
|
||||||
(lambda (x)
|
(lambda (e m* s*)
|
||||||
(and (vector? x)
|
(vector 'stx e m* s*)))
|
||||||
(= (vector-length x) 4)
|
(define stx?
|
||||||
(eq? (vector-ref x 0) 'stx))))
|
(lambda (x)
|
||||||
(define stx-expr
|
(and (vector? x)
|
||||||
(lambda (x)
|
(= (vector-length x) 4)
|
||||||
(if (stx? x)
|
(eq? (vector-ref x 0) 'stx))))
|
||||||
(vector-ref x 1)
|
(define stx-expr
|
||||||
(error 'stx-expr "~s is not a syntax object" x))))
|
(lambda (x)
|
||||||
(define stx-mark*
|
(if (stx? x)
|
||||||
(lambda (x)
|
(vector-ref x 1)
|
||||||
(if (stx? x)
|
(error 'stx-expr "~s is not a syntax object" x))))
|
||||||
(vector-ref x 2)
|
(define stx-mark*
|
||||||
(error 'stx-mark* "~s is not a syntax object" x))))
|
(lambda (x)
|
||||||
(define stx-subst*
|
(if (stx? x)
|
||||||
(lambda (x)
|
(vector-ref x 2)
|
||||||
(if (stx? x)
|
(error 'stx-mark* "~s is not a syntax object" x))))
|
||||||
(vector-ref x 3)
|
(define stx-subst*
|
||||||
(error 'stx-subst* "~s is not a syntax object" x))))
|
(lambda (x)
|
||||||
|
(if (stx? x)
|
||||||
|
(vector-ref x 3)
|
||||||
|
(error 'stx-subst* "~s is not a syntax object" x)))))
|
||||||
(define datum->stx
|
(define datum->stx
|
||||||
(lambda (id datum)
|
(lambda (id datum)
|
||||||
(make-stx datum (stx-mark* id) (stx-subst* id))))
|
(make-stx datum (stx-mark* id) (stx-subst* id))))
|
||||||
|
@ -241,16 +237,6 @@
|
||||||
(lambda (x y)
|
(lambda (x y)
|
||||||
(and (eq? (id->sym x) (id->sym y))
|
(and (eq? (id->sym x) (id->sym y))
|
||||||
(same-marks? (stx-mark* x) (stx-mark* y)))))
|
(same-marks? (stx-mark* x) (stx-mark* y)))))
|
||||||
(define-syntax bound-id-member?
|
|
||||||
(lambda (x)
|
|
||||||
(syntax-case x ()
|
|
||||||
[x (identifier? #'x) #'bound-id-member?^]
|
|
||||||
[(_ id id*)
|
|
||||||
#'(let ([t1 id] [t2 id*])
|
|
||||||
(unless (and (id? t1) (andmap id? t2))
|
|
||||||
(error 'bound-id-member? "~s ~s is not an id in ~s" t1 t2
|
|
||||||
'(_ id id*)))
|
|
||||||
(bound-id-member?^ t1 t2))])))
|
|
||||||
(define free-id=?
|
(define free-id=?
|
||||||
(lambda (i j)
|
(lambda (i j)
|
||||||
(let ((t0 (id->label i)) (t1 (id->label j)))
|
(let ((t0 (id->label i)) (t1 (id->label j)))
|
||||||
|
@ -266,11 +252,11 @@
|
||||||
(or (null? id*)
|
(or (null? id*)
|
||||||
(and (not (bound-id-member? (car id*) (cdr id*)))
|
(and (not (bound-id-member? (car id*) (cdr id*)))
|
||||||
(distinct-bound-ids? (cdr id*))))))
|
(distinct-bound-ids? (cdr id*))))))
|
||||||
(define bound-id-member?^
|
(define bound-id-member?
|
||||||
(lambda (id id*)
|
(lambda (id id*)
|
||||||
(and (pair? id*)
|
(and (pair? id*)
|
||||||
(or (bound-id=? id (car id*))
|
(or (bound-id=? id (car id*))
|
||||||
(bound-id-member?^ id (cdr id*))))))
|
(bound-id-member? id (cdr id*))))))
|
||||||
(define self-evaluating?
|
(define self-evaluating?
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(or (number? x) (string? x) (char? x) (boolean? x))))
|
(or (number? x) (string? x) (char? x) (boolean? x))))
|
||||||
|
@ -309,7 +295,6 @@
|
||||||
[else x])))))
|
[else x])))))
|
||||||
(define id->label
|
(define id->label
|
||||||
(lambda (id)
|
(lambda (id)
|
||||||
(assert id->label (id? id))
|
|
||||||
(let ([sym (id->sym id)])
|
(let ([sym (id->sym id)])
|
||||||
(let search ([subst* (stx-subst* id)] [mark* (stx-mark* id)])
|
(let search ([subst* (stx-subst* id)] [mark* (stx-mark* id)])
|
||||||
(cond
|
(cond
|
||||||
|
@ -625,6 +610,11 @@
|
||||||
[syntax-rules syntax-rules-macro (macro . syntax-rules)]
|
[syntax-rules syntax-rules-macro (macro . syntax-rules)]
|
||||||
[quasiquote quasiquote-macro (macro . quasiquote)]
|
[quasiquote quasiquote-macro (macro . quasiquote)]
|
||||||
[with-syntax with-syntax-label (macro . with-syntax)]
|
[with-syntax with-syntax-label (macro . with-syntax)]
|
||||||
|
[let let-label (macro . let)]
|
||||||
|
[let* let*-label (macro . let*)]
|
||||||
|
[cond cond-label (macro . cond)]
|
||||||
|
[and and-label (macro . and)]
|
||||||
|
[or or-label (macro . or)]
|
||||||
[case case-label (core-macro . case)]
|
[case case-label (core-macro . case)]
|
||||||
[foreign-call foreign-call-label (core-macro . foreign-call)]
|
[foreign-call foreign-call-label (core-macro . foreign-call)]
|
||||||
[quote quote-label (core-macro . quote)]
|
[quote quote-label (core-macro . quote)]
|
||||||
|
@ -633,16 +623,11 @@
|
||||||
[lambda lambda-label (core-macro . lambda)]
|
[lambda lambda-label (core-macro . lambda)]
|
||||||
[case-lambda case-lambda-label (core-macro . case-lambda)]
|
[case-lambda case-lambda-label (core-macro . case-lambda)]
|
||||||
[let-values let-values-label (core-macro . let-values)]
|
[let-values let-values-label (core-macro . let-values)]
|
||||||
[let let-label (core-macro . let)]
|
|
||||||
[type-descriptor type-descriptor-label (core-macro . type-descriptor)]
|
[type-descriptor type-descriptor-label (core-macro . type-descriptor)]
|
||||||
[letrec letrec-label (core-macro . letrec)]
|
[letrec letrec-label (core-macro . letrec)]
|
||||||
[let* let*-label (core-macro . let*)]
|
|
||||||
[cond cond-label (macro . cond)]
|
|
||||||
[if if-label (core-macro . if)]
|
[if if-label (core-macro . if)]
|
||||||
[when when-label (core-macro . when)]
|
[when when-label (core-macro . when)]
|
||||||
[unless unless-label (core-macro . unless)]
|
[unless unless-label (core-macro . unless)]
|
||||||
[and and-label (core-macro . and)]
|
|
||||||
[or or-label (core-macro . or)]
|
|
||||||
[parameterize parameterize-label (core-macro . parameterize)]
|
[parameterize parameterize-label (core-macro . parameterize)]
|
||||||
;;; prims
|
;;; prims
|
||||||
[void void-label (core-prim . void)]
|
[void void-label (core-prim . void)]
|
||||||
|
@ -1086,7 +1071,7 @@
|
||||||
(cons lab (cons 'lexical lex)))
|
(cons lab (cons 'lexical lex)))
|
||||||
lab* lex*)
|
lab* lex*)
|
||||||
r)))
|
r)))
|
||||||
(define let-values-transformer
|
(define let-values-transformer ;;; go away
|
||||||
(lambda (e r mr)
|
(lambda (e r mr)
|
||||||
(syntax-match e ()
|
(syntax-match e ()
|
||||||
[(_ ([(fml** ...) rhs*] ...) b b* ...)
|
[(_ ([(fml** ...) rhs*] ...) b b* ...)
|
||||||
|
@ -1112,36 +1097,6 @@
|
||||||
(build-lambda no-source '() (car rhs*))
|
(build-lambda no-source '() (car rhs*))
|
||||||
(build-lambda no-source (car lex**)
|
(build-lambda no-source (car lex**)
|
||||||
(f (cdr lex**) (cdr rhs*)))))])))))])))
|
(f (cdr lex**) (cdr rhs*)))))])))))])))
|
||||||
(define let*-transformer
|
|
||||||
(lambda (e r mr)
|
|
||||||
(syntax-match e ()
|
|
||||||
[(_ ([lhs* rhs*] ...) b b* ...)
|
|
||||||
(let f ([lhs* lhs*] [rhs* rhs*]
|
|
||||||
[subst-lhs* '()] [subst-lab* '()]
|
|
||||||
[r r])
|
|
||||||
(cond
|
|
||||||
[(null? lhs*)
|
|
||||||
(chi-internal
|
|
||||||
(add-subst
|
|
||||||
(make-full-rib subst-lhs* subst-lab*)
|
|
||||||
(cons b b*))
|
|
||||||
r mr)]
|
|
||||||
[else
|
|
||||||
(let ([lhs (car lhs*)]
|
|
||||||
[rhs (chi-expr
|
|
||||||
(add-subst
|
|
||||||
(make-full-rib subst-lhs* subst-lab*)
|
|
||||||
(car rhs*))
|
|
||||||
r mr)])
|
|
||||||
(unless (id? lhs)
|
|
||||||
(stx-error lhs "invalid binding"))
|
|
||||||
(let ([lex (gen-lexical lhs)]
|
|
||||||
[lab (gen-label lhs)])
|
|
||||||
(build-let no-source (list lex) (list rhs)
|
|
||||||
(f (cdr lhs*) (cdr rhs*)
|
|
||||||
(cons lhs subst-lhs*)
|
|
||||||
(cons lab subst-lab*)
|
|
||||||
(add-lexicals (list lab) (list lex) r)))))]))])))
|
|
||||||
(define letrec-transformer
|
(define letrec-transformer
|
||||||
(lambda (e r mr)
|
(lambda (e r mr)
|
||||||
(syntax-match e ()
|
(syntax-match e ()
|
||||||
|
@ -1175,46 +1130,7 @@
|
||||||
[($rtd)
|
[($rtd)
|
||||||
(build-data no-source (binding-value b))]
|
(build-data no-source (binding-value b))]
|
||||||
[else (stx-error e "invalid type")]))])))
|
[else (stx-error e "invalid type")]))])))
|
||||||
(define let-transformer
|
(define when-transformer ;;; go away
|
||||||
(lambda (e r mr)
|
|
||||||
(syntax-match e ()
|
|
||||||
[(_ ([lhs* rhs*] ...) b b* ...)
|
|
||||||
(if (not (valid-bound-ids? lhs*))
|
|
||||||
(stx-error e)
|
|
||||||
(let ([rhs* (chi-expr* rhs* r mr)]
|
|
||||||
[lex* (map gen-lexical lhs*)]
|
|
||||||
[lab* (map gen-label lhs*)])
|
|
||||||
(let ([body (chi-internal
|
|
||||||
(add-subst
|
|
||||||
(make-full-rib lhs* lab*)
|
|
||||||
(cons b b*))
|
|
||||||
(add-lexicals lab* lex* r)
|
|
||||||
mr)])
|
|
||||||
(build-application no-source
|
|
||||||
(build-lambda no-source lex* body)
|
|
||||||
rhs*))))]
|
|
||||||
[(_ loop ([lhs* rhs*] ...) b b* ...)
|
|
||||||
(if (and (id? loop) (valid-bound-ids? lhs*))
|
|
||||||
(let ([rhs* (chi-expr* rhs* r mr)]
|
|
||||||
[lex* (map gen-lexical lhs*)]
|
|
||||||
[lab* (map gen-label lhs*)]
|
|
||||||
[looplex (gen-lexical loop)]
|
|
||||||
[looplab (gen-label loop)])
|
|
||||||
(let ([b* (add-subst (make-full-rib (list loop) (list looplab))
|
|
||||||
(add-subst (make-full-rib lhs* lab*)
|
|
||||||
(cons b b*)))]
|
|
||||||
[r (add-lexicals
|
|
||||||
(cons looplab lab*)
|
|
||||||
(cons looplex lex*)
|
|
||||||
r)])
|
|
||||||
(let ([body (chi-internal b* r mr)])
|
|
||||||
(build-letrec no-source
|
|
||||||
(list looplex)
|
|
||||||
(list (build-lambda no-source lex* body))
|
|
||||||
(build-application no-source
|
|
||||||
looplex rhs*)))))
|
|
||||||
(stx-error e))])))
|
|
||||||
(define when-transformer
|
|
||||||
(lambda (e r mr)
|
(lambda (e r mr)
|
||||||
(syntax-match e ()
|
(syntax-match e ()
|
||||||
[(_ test e e* ...)
|
[(_ test e e* ...)
|
||||||
|
@ -1223,7 +1139,7 @@
|
||||||
(build-sequence no-source
|
(build-sequence no-source
|
||||||
(chi-expr* (cons e e*) r mr))
|
(chi-expr* (cons e e*) r mr))
|
||||||
(build-void))])))
|
(build-void))])))
|
||||||
(define unless-transformer
|
(define unless-transformer ;;; go away
|
||||||
(lambda (e r mr)
|
(lambda (e r mr)
|
||||||
(syntax-match e ()
|
(syntax-match e ()
|
||||||
[(_ test e e* ...)
|
[(_ test e e* ...)
|
||||||
|
@ -1245,7 +1161,7 @@
|
||||||
(chi-expr e0 r mr)
|
(chi-expr e0 r mr)
|
||||||
(chi-expr e1 r mr)
|
(chi-expr e1 r mr)
|
||||||
(build-void))])))
|
(build-void))])))
|
||||||
(define case-transformer
|
(define case-transformer ;;; go away
|
||||||
(lambda (e r mr)
|
(lambda (e r mr)
|
||||||
(define build-one
|
(define build-one
|
||||||
(lambda (t cls rest)
|
(lambda (t cls rest)
|
||||||
|
@ -1307,11 +1223,13 @@
|
||||||
(build-lambda no-source fmls body))])))
|
(build-lambda no-source fmls body))])))
|
||||||
(define bless
|
(define bless
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(let f ([x x])
|
(stx
|
||||||
(cond
|
(let f ([x x])
|
||||||
[(pair? x) (cons (f (car x)) (f (cdr x)))]
|
(cond
|
||||||
[(symbol? x) (scheme-stx x)]
|
[(pair? x) (cons (f (car x)) (f (cdr x)))]
|
||||||
[else x]))))
|
[(symbol? x) (scheme-stx x)]
|
||||||
|
[else x]))
|
||||||
|
'() '())))
|
||||||
(define with-syntax-macro
|
(define with-syntax-macro
|
||||||
(lambda (e)
|
(lambda (e)
|
||||||
(syntax-match e ()
|
(syntax-match e ()
|
||||||
|
@ -1319,6 +1237,51 @@
|
||||||
(bless
|
(bless
|
||||||
`(syntax-case (list . ,expr*) ()
|
`(syntax-case (list . ,expr*) ()
|
||||||
[,fml* (begin ,b . ,b*)]))])))
|
[,fml* (begin ,b . ,b*)]))])))
|
||||||
|
(define let-macro
|
||||||
|
(lambda (stx)
|
||||||
|
(syntax-match stx ()
|
||||||
|
[(_ ([lhs* rhs*] ...) b b* ...)
|
||||||
|
(if (valid-bound-ids? lhs*)
|
||||||
|
(bless `((lambda ,lhs* ,b . ,b*) . ,rhs*))
|
||||||
|
(stx-error stx "invalid syntax"))]
|
||||||
|
[(_ f ([lhs* rhs*] ...) b b* ...)
|
||||||
|
(if (and (id? f) (valid-bound-ids? lhs*))
|
||||||
|
(bless `(letrec ([,f (lambda ,lhs* ,b . ,b*)])
|
||||||
|
(,f . ,rhs*)))
|
||||||
|
(stx-error stx "invalid syntax"))])))
|
||||||
|
(define let*-macro
|
||||||
|
(lambda (stx)
|
||||||
|
(syntax-match stx ()
|
||||||
|
[(_ ([lhs* rhs*] ...) b b* ...)
|
||||||
|
(if (andmap id? lhs*)
|
||||||
|
(bless
|
||||||
|
(let f ([x* (map list lhs* rhs*)])
|
||||||
|
(cond
|
||||||
|
[(null? x*) `(let () ,b . ,b*)]
|
||||||
|
[else `(let (,(car x*)) ,(f (cdr x*)))])))
|
||||||
|
(stx-error stx "invalid bindings"))])))
|
||||||
|
(define or-macro
|
||||||
|
(lambda (stx)
|
||||||
|
(syntax-match stx ()
|
||||||
|
[(_) #f]
|
||||||
|
[(_ e e* ...)
|
||||||
|
(bless
|
||||||
|
(let f ([e e] [e* e*])
|
||||||
|
(cond
|
||||||
|
[(null? e*) `(begin #f ,e)]
|
||||||
|
[else
|
||||||
|
`(let ([t ,e])
|
||||||
|
(if t t ,(f (car e*) (cdr e*))))])))])))
|
||||||
|
(define and-macro
|
||||||
|
(lambda (stx)
|
||||||
|
(syntax-match stx ()
|
||||||
|
[(_) #t]
|
||||||
|
[(_ e e* ...)
|
||||||
|
(bless
|
||||||
|
(let f ([e e] [e* e*])
|
||||||
|
(cond
|
||||||
|
[(null? e*) `(begin #f ,e)]
|
||||||
|
[else `(if ,e ,(f (car e*) (cdr e*)) #f)])))])))
|
||||||
(define cond-macro
|
(define cond-macro
|
||||||
(lambda (stx)
|
(lambda (stx)
|
||||||
(syntax-match stx ()
|
(syntax-match stx ()
|
||||||
|
@ -1532,7 +1495,7 @@
|
||||||
"~s is not a record of type ~s"
|
"~s is not a record of type ~s"
|
||||||
x ',rtd)))))
|
x ',rtd)))))
|
||||||
setters i*))))])))
|
setters i*))))])))
|
||||||
(define parameterize-transformer
|
(define parameterize-transformer ;;; go away
|
||||||
(lambda (e r mr)
|
(lambda (e r mr)
|
||||||
(syntax-match e ()
|
(syntax-match e ()
|
||||||
[(_ () b b* ...)
|
[(_ () b b* ...)
|
||||||
|
@ -1568,36 +1531,6 @@
|
||||||
(build-lambda no-source '()
|
(build-lambda no-source '()
|
||||||
(chi-internal (cons b b*) r mr))
|
(chi-internal (cons b b*) r mr))
|
||||||
(build-lexical-reference no-source swap))))))])))
|
(build-lexical-reference no-source swap))))))])))
|
||||||
(define and-transformer
|
|
||||||
(lambda (e r mr)
|
|
||||||
(syntax-match e ()
|
|
||||||
[(_) (build-data no-source #t)]
|
|
||||||
[(_ e e* ...)
|
|
||||||
(let f ([e e] [e* e*])
|
|
||||||
(cond
|
|
||||||
[(null? e*) (chi-expr e r mr)]
|
|
||||||
[else
|
|
||||||
(build-conditional no-source
|
|
||||||
(chi-expr e r mr)
|
|
||||||
(f (car e*) (cdr e*))
|
|
||||||
(build-data no-source #f))]))])))
|
|
||||||
(define or-transformer
|
|
||||||
(lambda (e r mr)
|
|
||||||
(syntax-match e ()
|
|
||||||
[(_) (build-data no-source #f)]
|
|
||||||
[(_ e e* ...)
|
|
||||||
(let f ([e e] [e* e*])
|
|
||||||
(cond
|
|
||||||
[(null? e*) (chi-expr e r mr)]
|
|
||||||
[else
|
|
||||||
(let ([t (gen-lexical 't)])
|
|
||||||
(build-let no-source
|
|
||||||
(list t)
|
|
||||||
(list (chi-expr e r mr))
|
|
||||||
(build-conditional no-source
|
|
||||||
(build-lexical-reference no-source t)
|
|
||||||
(build-lexical-reference no-source t)
|
|
||||||
(f (car e*) (cdr e*)))))]))])))
|
|
||||||
(define foreign-call-transformer
|
(define foreign-call-transformer
|
||||||
(lambda (e r mr)
|
(lambda (e r mr)
|
||||||
(syntax-match e ()
|
(syntax-match e ()
|
||||||
|
@ -2090,15 +2023,11 @@
|
||||||
[(lambda) lambda-transformer]
|
[(lambda) lambda-transformer]
|
||||||
[(case-lambda) case-lambda-transformer]
|
[(case-lambda) case-lambda-transformer]
|
||||||
[(let-values) let-values-transformer]
|
[(let-values) let-values-transformer]
|
||||||
[(let) let-transformer]
|
|
||||||
[(letrec) letrec-transformer]
|
[(letrec) letrec-transformer]
|
||||||
[(let*) let*-transformer]
|
|
||||||
[(case) case-transformer]
|
[(case) case-transformer]
|
||||||
[(if) if-transformer]
|
[(if) if-transformer]
|
||||||
[(when) when-transformer]
|
[(when) when-transformer]
|
||||||
[(unless) unless-transformer]
|
[(unless) unless-transformer]
|
||||||
[(and) and-transformer]
|
|
||||||
[(or) or-transformer]
|
|
||||||
[(parameterize) parameterize-transformer]
|
[(parameterize) parameterize-transformer]
|
||||||
[(foreign-call) foreign-call-transformer]
|
[(foreign-call) foreign-call-transformer]
|
||||||
[(syntax-case) syntax-case-transformer]
|
[(syntax-case) syntax-case-transformer]
|
||||||
|
@ -2113,14 +2042,16 @@
|
||||||
(case x
|
(case x
|
||||||
[(define-record) define-record-macro]
|
[(define-record) define-record-macro]
|
||||||
[(include) include-macro]
|
[(include) include-macro]
|
||||||
[(cond) cond-macro]
|
[(cond) cond-macro]
|
||||||
|
[(let) let-macro]
|
||||||
|
[(or) or-macro]
|
||||||
|
[(and) and-macro]
|
||||||
|
[(let*) let*-macro]
|
||||||
[(syntax-rules) syntax-rules-macro]
|
[(syntax-rules) syntax-rules-macro]
|
||||||
[(quasiquote) quasiquote-macro]
|
[(quasiquote) quasiquote-macro]
|
||||||
[(with-syntax) with-syntax-macro]
|
[(with-syntax) with-syntax-macro]
|
||||||
[else (error 'macro-transformer
|
[else (error 'macro-transformer "invalid macro ~s" x)])]
|
||||||
"invalid macro ~s" x)])]
|
[else (error 'core-macro-transformer "invalid macro ~s" x)])))
|
||||||
[else (error 'core-macro-transformer
|
|
||||||
"invalid macro ~s" x)])))
|
|
||||||
;;; chi procedures
|
;;; chi procedures
|
||||||
(define chi-macro
|
(define chi-macro
|
||||||
(lambda (p e)
|
(lambda (p e)
|
||||||
|
@ -2501,7 +2432,6 @@
|
||||||
(let ([v (library-expander^ x)])
|
(let ([v (library-expander^ x)])
|
||||||
;(pretty-print v)
|
;(pretty-print v)
|
||||||
v)))
|
v)))
|
||||||
|
|
||||||
(primitive-set! 'identifier? id?)
|
(primitive-set! 'identifier? id?)
|
||||||
(primitive-set! 'generate-temporaries
|
(primitive-set! 'generate-temporaries
|
||||||
(lambda (ls)
|
(lambda (ls)
|
||||||
|
@ -2525,4 +2455,3 @@
|
||||||
(primitive-set! 'syntax-dispatch syntax-dispatch)
|
(primitive-set! 'syntax-dispatch syntax-dispatch)
|
||||||
(primitive-set! 'chi-top-library library-expander))
|
(primitive-set! 'chi-top-library library-expander))
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,8 +1,3 @@
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;; Finally, we're ready to evaluate the files and enter the cafe.
|
;;; Finally, we're ready to evaluate the files and enter the cafe.
|
||||||
(library (ikarus interaction)
|
(library (ikarus interaction)
|
||||||
(export)
|
(export)
|
||||||
|
@ -56,10 +51,8 @@
|
||||||
(define-syntax compile-time-string
|
(define-syntax compile-time-string
|
||||||
(lambda (x) (date-string)))
|
(lambda (x) (date-string)))
|
||||||
(printf "Ikarus Scheme (Build ~a)\n" (compile-time-string)))
|
(printf "Ikarus Scheme (Build ~a)\n" (compile-time-string)))
|
||||||
;(printf "Ikarus Scheme (Build ~a)\n" (compile-time-date-string))
|
|
||||||
(display "Copyright (c) 2006-2007 Abdulaziz Ghuloum\n\n")
|
(display "Copyright (c) 2006-2007 Abdulaziz Ghuloum\n\n")
|
||||||
(command-line-arguments args)
|
(command-line-arguments args)
|
||||||
(for-each load files)
|
(for-each load files)
|
||||||
(new-cafe)
|
(new-cafe)
|
||||||
(exit 0)])))
|
(exit 0)])))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue