From 4f3f35a188e9c32dea53b34fc0612791008fe75a Mon Sep 17 00:00:00 2001
From: Jon Rafkind <rafkind@racket-lang.org>
Date: Tue, 15 Dec 2009 22:49:01 +0000
Subject: [PATCH] wrap module with the typed-scheme module-begin

svn: r17316
---
 collects/honu/private/honu-typed-scheme.ss | 12 +++++++++---
 collects/honu/private/util.ss              |  6 +++++-
 2 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/collects/honu/private/honu-typed-scheme.ss b/collects/honu/private/honu-typed-scheme.ss
index 6419c4bcbd..fdb7cc1c15 100644
--- a/collects/honu/private/honu-typed-scheme.ss
+++ b/collects/honu/private/honu-typed-scheme.ss
@@ -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 ...)))
diff --git a/collects/honu/private/util.ss b/collects/honu/private/util.ss
index 436ec2f2b2..fe11586a0f 100644
--- a/collects/honu/private/util.ss
+++ b/collects/honu/private/util.ss
@@ -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]