Changeset 3740 for src/Pugs/Prim.hs

Timestamp:

05/23/05 16:57:32 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

5329

Message:

* move enterEvalContext to Monads.hs so Prim can use it.
* introduce the maybeM abstraction that lifts fmapM into monads.

Files:

• src/Pugs/Prim.hs (modified) (6 diffs)

src/Pugs/Prim.hs

@@ -27 +27 @@
 import Pugs.AST
 import Pugs.Types
+import Pugs.Monads
 import Pugs.Pretty
 import Text.Printf
@@ -178 +179 @@
         Just subVal -> do
             sub <- fromVal subVal
-            evl <- asks envEval
             sorted <- (`sortByM` valList) $ \v1 v2 -> do
-                rv  <- local (\e -> e{ envContext = cxtItem "Int" }) $ do
-                    evl (App (Val sub) [Val v1, Val v2] [])
+                rv  <- enterEvalContext (cxtItem "Int") $ App (Val sub) [Val v1, Val v2] []
                 int <- fromVal rv
                 return (int <= (0 :: Int))
@@ -406 +405 @@
     tid     <- liftIO . (if rtsSupportsBoundThreads then forkOS else forkIO) $ do
         val <- runEvalIO env $ do
-            evl <- asks envEval
-            local (\e -> e{ envContext = CxtVoid }) $ do
-                evl (App (Val code) [] [])
+            enterEvalContext CxtVoid $ App (Val code) [] []
         liftSTM $ tryPutTMVar lock val
         return ()
@@ -827 +824 @@
     writeIVar (IHash attrs) named
     uniq    <- liftIO $ newUnique
-    return . VObject $ MkObject{ objType = typ, objAttrs = attrs, objId = uniq }
+    let obj = VObject $ MkObject{ objType = typ, objAttrs = attrs, objId = uniq }
+    -- Now start calling BUILD for each of parent classes (if defined)
+
+    return obj
 op3 other = \_ _ _ -> fail ("Unimplemented 3-ary op: " ++ other)
 
@@ -880 +880 @@
         = doHyper =<< readRef x'
         | otherwise
-        = do
-            evl <- asks envEval
-            local (\e -> e{ envContext = cxtItemAny }) $ do
-                evl (App (Val $ VCode sub) [Val x] [])
+        = enterEvalContext cxtItemAny $ App (Val $ VCode sub) [Val x] []
     hyperList []     = return []
     hyperList (x:xs) = do
@@ -910 +907 @@
     = fail "Hyper OP only works on lists"
     where
-    doHyper x y = do
-        evl <- asks envEval
-        local (\e -> e{ envContext = cxtItemAny }) $ do
-            evl (App (Val $ VCode sub) [Val x, Val y] [])
+    doHyper x y = enterEvalContext cxtItemAny $ App (Val $ VCode sub) [Val x, Val y] []
     hyperLists [] [] = return []
     hyperLists xs [] = return xs