wrap module with the typed-scheme module-begin
svn: r17316
This commit is contained in:
parent
a23c519ac8
commit
4f3f35a188
|
@ -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 ...)))
|
||||
|
|
|
@ -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]
|
||||
|
|
Loading…
Reference in New Issue
Block a user