wrap module with the typed-scheme module-begin

svn: r17316
This commit is contained in:
Jon Rafkind 2009-12-15 22:49:01 +00:00
parent a23c519ac8
commit 4f3f35a188
2 changed files with 14 additions and 4 deletions

View File

@ -1,5 +1,6 @@
#lang scheme/base
(require (rename-in typed-scheme/minimal (#%module-begin #%module-begin-typed-scheme)))
(require (for-syntax scheme/base
syntax/stx
syntax/parse
@ -18,6 +19,7 @@
(define-literal honu-return)
(begin-for-syntax
(define-values (prop:honu-transformer honu-transformer? honu-transformer-ref)
@ -83,9 +85,6 @@
(or (bound-transformer stx)
(special-transformer stx)))
(define (call-values function values-producing)
(call-with-values (lambda () values-producing) function))
;; these functions use parse-block-one
;; (define parse-a-tail-expr #f)
;; (define parse-an-expr #f)
@ -295,6 +294,7 @@
(parse-expr (syntax->list #'(expr ...)))]
[else (parse-expr expr-stxs)]))
(define (parse-block-one context body combine-k done-k)
(define (parse-one expr-stxs after-expr terminator)
(define (checks)
@ -331,6 +331,10 @@
)
(define (show-top-result v)
(unless (void? v)
(printf "~s\n" v)))
(define-syntax (honu-unparsed-begin stx)
(syntax-case stx ()
[(_) #'(begin)]
@ -344,4 +348,6 @@
#'(begin code (honu-unparsed-begin rest ...))))]))
(define-syntax-rule (#%dynamic-honu-module-begin forms ...)
(#%module-begin-typed-scheme (honu-unparsed-begin forms ...))
#;
(#%plain-module-begin (honu-unparsed-begin forms ...)))

View File

@ -2,7 +2,8 @@
(provide delim-identifier=?
extract-until)
extract-until
call-values)
(require syntax/stx)
@ -29,6 +30,9 @@
(loop (stx-cdr r) (cons (stx-car r) val-stxs))]))]
[(r ids) (extract-until r ids #f)]))
(define-syntax-rule (call-values function values-producing)
(call-with-values (lambda () values-producing) function))
(define (test)
(let* ([original #'(a b c d e)]
[delimiter #'c]