From 932f831a25f9251cc321a5d95492d88fcb7e16c5 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Fri, 6 Oct 2006 04:53:15 +0000
Subject: [PATCH] Trying to improve module handling

svn: r4506

original commit: 595ed011724ba002a3bf400be4c6fa7c494189a9
---
 collects/macro-debugger/model/debug.ss        | 2 +-
 collects/macro-debugger/model/deriv-c.ss      | 2 +-
 collects/macro-debugger/model/deriv-parser.ss | 7 +++++--
 collects/macro-debugger/model/deriv.ss        | 2 +-
 collects/macro-debugger/model/reductions.ss   | 7 ++++++-
 collects/macro-debugger/model/trace-raw.ss    | 2 +-
 6 files changed, 15 insertions(+), 7 deletions(-)

diff --git a/collects/macro-debugger/model/debug.ss b/collects/macro-debugger/model/debug.ss
index 9297742..8cae6af 100644
--- a/collects/macro-debugger/model/debug.ss
+++ b/collects/macro-debugger/model/debug.ss
@@ -57,7 +57,7 @@
          (append (loops rhss) (loop body))]
         [(AnyQ p:letrec-syntaxes+values (_ _ _ _ srhss _ vrhss body))
          (append (loops srhss) (loops vrhss) (loop body))]
-        [(AnyQ p:module (_ _ _ body))
+        [(AnyQ p:module (_ _ _ _ body))
          (loop body)]
         [(AnyQ p:#%module-begin (_ _ _ pass1 pass2))
          (append (loops pass1) (loops pass2))]
diff --git a/collects/macro-debugger/model/deriv-c.ss b/collects/macro-debugger/model/deriv-c.ss
index 23b5294..bc494c6 100644
--- a/collects/macro-debugger/model/deriv-c.ss
+++ b/collects/macro-debugger/model/deriv-c.ss
@@ -72,7 +72,7 @@
   (define-struct (p:unknown p::STOP) () #f)
   
   ;; Module stuff.... hairy
-  (define-struct (p:module prule) (body) #f)
+  (define-struct (p:module prule) (one-body-form? body) #f)
   (define-struct (p:#%module-begin prule) (pass1 pass2) #f)
   ;; where pass1 is a ModPass1
   ;;   and pass2 is a ModPass2
diff --git a/collects/macro-debugger/model/deriv-parser.ss b/collects/macro-debugger/model/deriv-parser.ss
index fd1ab6b..d5a7bd1 100644
--- a/collects/macro-debugger/model/deriv-parser.ss
+++ b/collects/macro-debugger/model/deriv-parser.ss
@@ -217,14 +217,17 @@
       ;; Modules
       (PrimModule
        (#:args e1 e2 rs)
+       ;; Multiple forms after language
+       ;; #%module-begin tagging done automatically
        [(prim-module ! (? EE 'body))
-        (make-p:module e1 e2 rs $3)]
+        (make-p:module e1 e2 rs #f $3)]
 
        ;; One form after language ... macro that expands into #%module-begin
-       [(prim-module NoError next 
+       [(prim-module NoError next
                      enter-check (? CheckImmediateMacro/Inner) exit-check
                      (! 'module-begin) next (? EE))
         (make-p:module e1 e2 rs 
+                       #t
                        ($5 $4 
                            (and (deriv? $9) (deriv-e2 $9))
                            (lambda (ce1 ce2) $9)))])
diff --git a/collects/macro-debugger/model/deriv.ss b/collects/macro-debugger/model/deriv.ss
index 7eb517f..49df102 100644
--- a/collects/macro-debugger/model/deriv.ss
+++ b/collects/macro-debugger/model/deriv.ss
@@ -117,7 +117,7 @@
            (struct p:let-values (renames body))
            (struct p:letrec-values (renames rhss body))
            (struct p:letrec-syntaxes+values (srenames srhss vrenames vrhss body))
-           (struct p:module (body))
+           (struct p:module (one-body-form? body))
            (struct p:#%module-begin (pass1 pass2))
            (struct p::STOP ())
            (struct p:#%datum (tagged-stx))
diff --git a/collects/macro-debugger/model/reductions.ss b/collects/macro-debugger/model/reductions.ss
index b4d09db..7fe33e4 100644
--- a/collects/macro-debugger/model/reductions.ss
+++ b/collects/macro-debugger/model/reductions.ss
@@ -28,13 +28,18 @@
       ;; Primitives
       [(struct p:variable (e1 e2 rs))
        null]
-      [(IntQ p:module (e1 e2 rs body))
+      [(IntQ p:module (e1 e2 rs #f body))
        (with-syntax ([(?module name language . BODY) e1])
          (let ([ctx (lambda (x) (d->so e1 `(,#'?module ,#'name ,#'language ,x)))]
                [body-e1 (match body [($$ deriv (body-e1 _) _) body-e1])])
            (cons (walk e1 (ctx body-e1) "Tag #%module-begin")
                  (with-context ctx
                    (reductions body)))))]
+      [(IntQ p:module (e1 e2 rs #t body))
+       (with-syntax ([(?module name language . BODY) e1])
+         (let ([ctx (lambda (x) (d->so e1 `(,#'?module ,#'name ,#'language ,x)))])
+           (with-context ctx
+             (reductions body))))]
       [(IntQ p:#%module-begin (e1 e2 rs pass1 pass2))
        #;(R e1 (?module-begin . MBODY)
             [! exni 'blah]
diff --git a/collects/macro-debugger/model/trace-raw.ss b/collects/macro-debugger/model/trace-raw.ss
index 2aede4f..1ae63bb 100644
--- a/collects/macro-debugger/model/trace-raw.ss
+++ b/collects/macro-debugger/model/trace-raw.ss
@@ -1,6 +1,6 @@
 
 (module trace-raw mzscheme
-  (require "../syntax-browser/syntax-browser.ss"
+  (require "../syntax-browser.ss"
            (lib "class.ss")
            (lib "lex.ss" "parser-tools")
            "deriv-tokens.ss"