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")
(provide/contract [compile/defns
(tenv? tenv? (listof honu:defn?)
. -> .
(cons/c any/c (listof (syntax/c any/c))))]
((tenv? tenv? (listof honu:defn?))
. ->* .
(any/c (listof (syntax/c any/c))))]
[compile/interaction
((tenv?
tenv?

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

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

10
collects/honu/tool.ss
View File

@ -86,11 +86,13 @@
(if (eof-object? (peek-char-or-special port))
eof
(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
;; Check Syntax breaks (unsurprisingly), so we'll just do special
;; 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)
(let ([name (object-name port)])
(lambda ()
@ -140,8 +142,8 @@
;; window, so just eval it.
;;
;; well, remove the cruft I added to get Check Syntax to work first.
[(_ type-cruft stx ...)
(old-current-eval (syntax-as-top #'(begin stx ...)))]))))
[(_ type-cruft real-stx)
(old-current-eval (syntax-as-top #'real-stx))]))))
(namespace-attach-module n path)
(namespace-require path)))))
(define/public (render-value value settings port)