Changeset 16415

Timestamp:

05/18/07 00:16:09 (18 months ago)

Author:

audreyt

Message:

* Misc. stylistic cleanups in Pugs.AST and Pugs.Eval.

Location:

src/Pugs

Files:

• AST.hs (modified) (1 diff)
• Eval.hs (modified) (8 diffs)

src/Pugs/AST.hs

@@ -375 +375 @@
     { isMulti       = True
     , subName       = cast name
-    , subLexPads    = []
+    , subOuterPads  = []
+    , subInnerPad   = emptyPad
+--  , subLexical    = emptyPad
+    , subStarted    = Nothing
     , subPackage    = emptyPkg
     , subType       = SubMacro

src/Pugs/Eval.hs

@@ -415 +415 @@
 reduceSyn "" [Syn "block" [Val (VCode code)]] = do 
     -- Reclose all global pads!
-    glob <- asks envGlobal
+    glob    <- asks envGlobal
     stm $ do
         pad     <- readMPad glob
@@ -1359 +1359 @@
         _                       -> return []
     -}
-    let withInv | styp <= SubMethod = (ApplyArg (cast "&self") (argValue arg) False:)
+    let withInv | styp <= SubMethod = (ApplyArg (cast "$__SELF__") (argValue arg) False:)
                 | otherwise         = id
     sequence_ [ bindVar var val
@@ -1370 +1370 @@
 bindVar :: Var -> Val -> Eval ()
 bindVar var val
-    | isLexicalVar var  = doBindVar (asks envLexical)
-    | otherwise         = doBindVar askGlobal
+    | isLexicalVar var  = do
+        -- warn "Binding lexical" var
+        doBindVar (asks envLexical)
+    | otherwise         = do
+        -- warn "Binding global" var
+        doBindVar askGlobal
     where
     doBindVar askPad = do
@@ -1378 +1382 @@
             Just PEConstant{} -> fail $ "Cannot rebind constant: " ++ show var
             Just c -> do
+                -- warn "Binding lexical on" (var, c)
                 ref <- fromVal val
                 stm $ writeTVar (pe_store c) ref
@@ -1420 +1425 @@
         -> [Exp]       -- ^ List of arguments (not including explicit invocant)
         -> Eval Val
-doApply appKind sub@MkCode{ subCont = cont, subBody = fun, subType = typ } invs args = do
+doApply appKind origSub@MkCode{ subCont = cont, subBody = fun, subType = typ } invs args = do
     realInvs <- fmapM reduceNamedArg invs
     realArgs <-  mapM reduceNamedArg args  
@@ -1435 +1440 @@
             bound <- mapM doBind (subBindings sub)
             -- trace (show bound) $ return ()
-            val <- local fixEnv $ do
+            val <- localEnv $ do
                 (`juncApply` bound) $ \realBound -> do
-                    enterSub appKind sub $ case cont of
-                        Just tvar   -> do
-                            thunk <- stm $ readTVar tvar
-                            applyThunk (subType sub) realBound thunk
-                        Nothing     -> applyExp (subType sub) realBound fun
+                    enterSub appKind sub $ do
+                        lex     <- asks envLexical
+                        recRef  <- fromVal (VCode origSub)
+                        let tryRecBind var
+                                | Just{} <- lookupPad var (subInnerPad sub)
+                                , Just c <- lookupPad var lex
+                                = writePadEntry c recRef 
+                                | otherwise = return ()
+                        tryRecBind (cast "&?BLOCK")
+                        tryRecBind (cast "&?ROUTINE")
+                        case cont of
+                            Just tvar   -> do
+                                thunk <- stm $ readTVar tvar
+                                applyThunk (subType sub) realBound thunk
+                            Nothing     -> applyExp (subType sub) realBound fun
             case typ of 
                 SubMacro    -> applyMacroResult val 
@@ -1461 +1476 @@
     applyMacroResult VUndef         = retEmpty
     applyMacroResult _              = fail "Macro did not return an AST, a Str or a Code!"
+    localEnv = case appKind of
+        AKDisplaced  -> enterCaller
+        _            -> id
     fixSub sub env = env
         { envPackage = subPackage sub
         , envLexPads = subOuterPads sub
         }
-    fixEnv :: Env -> Env
-    fixEnv | typ >= SubBlock = id
-           | otherwise       = envEnterCaller
     doBind :: (Param, Exp) -> Eval ApplyArg -- ([PadMutator], [ApplyArg])
     doBind (prm, exp) = do
@@ -1474 +1489 @@
         (val, coll) <- enterContext cxt $ case exp of
             Syn "param-default" [exp, Val (VCode sub)] -> do
-                local (fixEnv . fixSub sub) $ expToVal prm exp
+                localEnv . local (fixSub sub) $ expToVal prm exp
             _  -> expToVal prm exp
         -- traceM ("==> " ++ (show val))