Changeset 16375

Timestamp:

05/17/07 23:38:23 (18 months ago)

Author:

audreyt

Message:

* Reclose the MAIN code as well.

Location:

src/Pugs

Files:

• Eval.hs (modified) (3 diffs)
• Monads.hs (modified) (1 diff)
• Parser/Program.hs (modified) (1 diff)

src/Pugs/Eval.hs

@@ -413 +413 @@
 reduceSyn :: String -> [Exp] -> Eval Val
 
-reduceSyn "" [] = do 
+reduceSyn "" [Syn "block" [Val (VCode code)]] = do 
     -- Reclose all global pads!
     glob <- asks envGlobal
@@ -420 +420 @@
         pad'    <- reclosePad pad
         writeMPad glob pad'
-        return undef
+        fmap VCode (recloseCode code)
 
 reduceSyn "()" [exp] = reduce exp
@@ -468 +468 @@
     started         <- if isCompileTime env then return Nothing else fmap Just (stm $ newTVar False)
     inner           <- clonePad (subInnerPad sub) 
-    (lpads, outer)  <- cloneLexPads (envLexPads env)
+--  (lpads, outer)  <- cloneLexPads (envLexPads env)
     return $ VCode sub
         { subCont       = cont
-        , subOuterPads  = lpads
+--      , subOuterPads  = lpads
         , subInnerPad   = inner
 --      , subLexical    = outer `mappend` inner 

src/Pugs/Monads.hs

@@ -22 +22 @@
     enterFrame, assertFrame, emptyFrames,
 
-    reclosePad,
+    reclosePad, recloseCode,
     
     MaybeT, runMaybeT,

src/Pugs/Parser/Program.hs

@@ -189 +189 @@
 
     -- Force a reclose-pad evaluation here by way of unsafeEvalExp.
-    unsafeEvalExp $ Syn "" []
+    main' <- unsafeEvalExp $ Syn "" [unwrap main]
 
     env' <- getRuleEnv
     return $ env'
-        { envBody       = App main Nothing [] -- _Var "@*ARGS"]
+        { envBody       = App (Syn "block" [main']) Nothing [] -- _Var "@*ARGS"]
         , envPackage    = envPackage env
         }