Changeset 14152 for src/Pugs/Eval.hs

Timestamp:

10/09/06 17:27:28 (2 years ago)

Author:

audreyt

Message:

* Revamp the "gather" structure, after discussion with TimToady?++

so that "take" is dynamic, although still fails if the callers
contains no "gather" frames.

Files:

• src/Pugs/Eval.hs (modified) (5 diffs)

src/Pugs/Eval.hs

@@ -74 +74 @@
         , envCaller  = Nothing
         , envOuter   = Nothing
-        , envDepth   = []
+        , envFrames  = emptyFrames
         , envBody    = Val undef
         , envDebug   = Just ref -- Set to "Nothing" to disable debugging
@@ -500 +500 @@
 reduceSyn "gather" [exp] = do
     sub     <- fromVal =<< evalExp exp
-    av      <- newArray []
-    symTake <- genSym (cast "@?TAKE") (MkRef av)
-    apply (updateSubPad sub symTake) Nothing []
-    fmap VList $ readIVar av
+    globTV  <- asks envGlobal
+    glob    <- liftSTM $ readTVar globTV
+    oldAV   <- findSymRef takeVar glob
+    oldSym  <- genSym takeVar oldAV
+    newAV   <- newObject (mkType "Array")
+    newSym  <- genSym takeVar newAV
+    liftSTM $ writeTVar globTV (newSym glob)
+    enterGather $ apply sub Nothing []
+    readRef newAV `finallyM` liftSTM (modifyTVar globTV oldSym)
+    where
+    takeVar = cast "$*TAKE"
 
 reduceSyn "loop" exps = enterLoop $ do
@@ -733 +740 @@
     let varname = sigil:(concat . (intersperse "::") $ parts)
     -- Finally, eval the varname.
-    evalExp . _Var $ varname
+    reduceVar (possiblyFixOperatorName (cast varname))
 
 reduceSyn "{}" [listExp, indexExp] = do
@@ -954 +961 @@
                    , envContext = envContext caller
                    , envLValue  = envLValue caller
-                   , envDepth   = envDepth caller
+                   , envFrames  = envFrames caller
                    , envPos     = envPos caller
                    }
@@ -968 +975 @@
                    , envContext = envContext caller
                    , envLValue  = envLValue caller
-                   , envDepth   = envDepth caller
+                   , envFrames  = envFrames caller
                    , envPos     = envPos caller
                    }