suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Separated out the cruft for syntax into a separate value until it gets into

Browse Source 
the tool, where we combine it, and then drop it appropriately.

svn: r348
This commit is contained in:
Stevie Strickland 2005-07-05 18:38:24 +00:00
parent d705858435
commit c7fb7b5ec5
3 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/honu/compile.ss
View File

@ -17,9 +17,9 @@
"private/typechecker/typecheck-expression.ss") "private/typechecker/typecheck-expression.ss")
(provide/contract [compile/defns (provide/contract [compile/defns
(tenv? tenv? (listof honu:defn?) ((tenv? tenv? (listof honu:defn?))
. -> . . ->* .
(cons/c any/c (listof (syntax/c any/c))))] (any/c (listof (syntax/c any/c))))]
[compile/interaction [compile/interaction
((tenv? ((tenv?
tenv? tenv?

10
collects/honu/private/compiler/translate.ss
View File

@ -13,9 +13,9 @@
"translate-unwanted-types.ss" "translate-unwanted-types.ss"
"translate-utils.ss") "translate-utils.ss")
(provide/contract [translate ((listof honu:defn?) (provide/contract [translate (((listof honu:defn?))
. -> . . ->* .
(cons/c any/c (listof (syntax/c any/c))))] (any/c (listof (syntax/c any/c))))]
[translate-defn (honu:defn? [translate-defn (honu:defn?
. -> . . -> .
(syntax/c any/c))]) (syntax/c any/c))])
@ -24,8 +24,8 @@
[syntaxes '()]) [syntaxes '()])
(cond (cond
[(null? defns-to-go) [(null? defns-to-go)
(cons (build-unwanted-type-syntax defns) (values (build-unwanted-type-syntax defns)
(reverse syntaxes))] ( reverse syntaxes))]
[(honu:subclass? (car defns-to-go)) [(honu:subclass? (car defns-to-go))
(let ([mixin (find (lambda (d) (let ([mixin (find (lambda (d)
(and (honu:mixin? d) (and (honu:mixin? d)

10
collects/honu/tool.ss
View File

@ -86,11 +86,13 @@
(if (eof-object? (peek-char-or-special port)) (if (eof-object? (peek-char-or-special port))
eof eof
(let* ([parsed (level-parser port name)]) (let* ([parsed (level-parser port name)])
(let ([compiled-defns (compile/defns tenv lenv parsed)]) (let-values ([(cruft-for-stx compiled-defns) (compile/defns tenv lenv parsed)])
;; if we wrap this in something special for the syntax-case below, then ;; if we wrap this in something special for the syntax-case below, then
;; Check Syntax breaks (unsurprisingly), so we'll just do special ;; Check Syntax breaks (unsurprisingly), so we'll just do special
;; wrappers for the interaction stuff. ;; wrappers for the interaction stuff.
(datum->syntax-object #f (cons 'begin compiled-defns) #f))))))) (datum->syntax-object #f (list 'begin cruft-for-stx
(datum->syntax-object #f (cons 'begin compiled-defns) #f))
#f)))))))
(define/public (front-end/interaction port settings teachpack-cache) (define/public (front-end/interaction port settings teachpack-cache)
(let ([name (object-name port)]) (let ([name (object-name port)])
(lambda () (lambda ()
@ -140,8 +142,8 @@
;; window, so just eval it. ;; window, so just eval it.
;; ;;
;; well, remove the cruft I added to get Check Syntax to work first. ;; well, remove the cruft I added to get Check Syntax to work first.
[(_ type-cruft stx ...) [(_ type-cruft real-stx)
(old-current-eval (syntax-as-top #'(begin stx ...)))])))) (old-current-eval (syntax-as-top #'real-stx))]))))
(namespace-attach-module n path) (namespace-attach-module n path)
(namespace-require path))))) (namespace-require path)))))
(define/public (render-value value settings port) (define/public (render-value value settings port)