Changeset 15420 for src/Pugs/Eval.hs

Timestamp:

03/03/07 14:57:49 (21 months ago)

Author:

audreyt

Message:

* Pugs.Eval: Chase Feed/Capture changes. (We switched

from a lazy [Val] into a parallel-friendly strict [:Val:].)

Files:

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

src/Pugs/Eval.hs

@@ -1 @@
-{-# OPTIONS_GHC -fglasgow-exts -cpp -fno-warn-deprecations -fallow-overlapping-instances #-}
+{-# OPTIONS_GHC -fglasgow-exts -cpp -fno-warn-deprecations -fallow-overlapping-instances -fparr #-}
 
 {-|
@@ -40 +40 @@
 import Pugs.Eval.Var
 import DrIFT.YAML ()
+import GHC.PArr
 import qualified Data.ByteString.Char8 as Buf
 
@@ -1029 +1030 @@
                    }
         vcap <- case args of
-            []      -> return (CaptSub { c_feeds = [] })
+            []      -> return (CaptSub { c_feeds = [::] })
             (x:_)   -> castVal =<< fromVal =<< enterRValue (enterEvalContext (cxtItem "Capture") x)
         local callerEnv $ applyCapture sub vcap
@@ -1039 +1040 @@
     , "&infix:=>"   ... reduceSyn "=>"
     , "&circumfix:\\( )" ... \invs args -> do
-        feeds <- argsFeed [] Nothing [args]
+        feeds <- argsFeed [::] Nothing [args]
         case invs of
             Just i' -> do
                 invVal  <- reduce i'
                 vv      <- fromVal invVal
-                return $ VV $ val $ CaptMeth{ c_invocant = vv, c_feeds = feeds }
+                return . VV . mkVal $ CaptMeth{ c_invocant = vv, c_feeds = feeds }
             Nothing -> do
-                return $ VV $ val $ CaptSub{ c_feeds = feeds }
+                return . VV . mkVal $ CaptSub{ c_feeds = feeds }
     , "&prefix:|<<" ... reduceSyn "," -- XXX this is wrong as well - should handle at args level
     ]
@@ -1080 +1081 @@
 
 applyCapture :: VCode -> ValCapt -> Eval Val
-applyCapture sub capt = apply sub inv (argsPos ++ argsNam)
-    where
-    argsPos = map (Val . castV) (f_positionals feed)
-    argsNam = [Syn "named" [Val (VStr (cast k)), Val (castV (last vs))] | (k, vs@(_:_)) <- Map.toList $ f_nameds feed ]
-    feed = mconcat (c_feeds capt)
+applyCapture sub capt = apply sub inv (fromP argsPos ++ argsNam)
+    where
+    argsPos = mapP (Val . castV) (f_positionals feed)
+    argsNam = [ Syn "named" [Val (VStr (cast k)), Val (castV (vs !: lst))] | (k, vs) <- Map.toList (f_nameds feed), let lst = length vs - 1, lst >= 0 ]
+    feed = concatFeeds (c_feeds capt)
     inv  = case capt of 
         CaptMeth { c_invocant = val }   -> Just (Val (castV val))
         _                               -> Nothing
 
-argsFeed :: [ValFeed] -> Maybe ValFeed -> [[Exp]] -> Eval [ValFeed]
-argsFeed fAcc aAcc [] = return $ fAcc ++ maybeToList aAcc
-argsFeed fAcc aAcc [[]] = return $ fAcc ++ maybeToList aAcc
+argsFeed :: [:ValFeed:] -> Maybe ValFeed -> [[Exp]] -> Eval [:ValFeed:]
+argsFeed fAcc Nothing [] =   return fAcc
+argsFeed fAcc Nothing [[]]  = return fAcc
+argsFeed fAcc (Just x) []   = return $ fAcc +:+ [:x:]
+argsFeed fAcc (Just x) [[]] = return $ fAcc +:+ [:x:]
 argsFeed fAcc aAcc (argl:als) = do
     acc <- af aAcc argl
@@ -1106 +1109 @@
         | Syn "|" (capExp:_) <- unwrapN = do
             cap <- castVal =<< fromVal =<< enterRValue (enterEvalContext (cxtItem "Capture") capExp)
-            af (Just (mconcat (resFeed:c_feeds cap))) args
+            af (Just (mconcat (resFeed:fromP (c_feeds cap)))) args
         | App (Var var) Nothing capExps <- unwrapN
         , var == cast "&prefix:|<<" = do
             caps    <- mapM castVal =<< fromVals =<< (enterRValue $ enterEvalContext (cxtSlurpy "Capture") (Syn "," capExps))
-            af (Just (mconcat (resFeed:concatMap c_feeds caps))) args
+            af (Just (mconcat (resFeed:concatMap (fromP . c_feeds) caps))) args
         | otherwise = do
             argVal  <- fromVal =<< reduce n
-            af (Just resFeed{ f_positionals = (f_positionals resFeed) ++ [argVal] }) args
+            af (Just resFeed{ f_positionals = (f_positionals resFeed) +:+ [:argVal:] }) args
         where
         unwrapN = unwrap n
         resFeed = feed res
     feed res = maybe emptyFeed id res
-    addNamed :: (Map ID [a]) -> VStr -> a -> Map ID [a]
+    addNamed :: (Map ID [:a:]) -> VStr -> a -> Map ID [:a:]
     addNamed mp k v =
         let id = cast k in
-        Map.insertWith (flip (++)) id [v] mp
+        Map.insertWith (flip (+:+)) id [:v:] mp
 
 dummyVar :: Var
@@ -1172 +1175 @@
     (k, v) <- pair_fetch pv
     return [ Syn "named" [Val k, Val v] ]
-interpolateVal (VV vv) | Just (CaptSub{ c_feeds = feeds } :: ValCapt) <- castVal vv = return $
-    [ Val (castV v) | v <- concatMap f_positionals feeds ]
-    ++ [ Syn "named" [Val (VStr $ cast k), Val (concatNamed v)] | (k, v) <- concatMap (Map.toList . f_nameds) feeds ]
-    where
-    concatNamed [x] = castV x
-    concatNamed xs  = VList (map castV xs)
+interpolateVal (VV vv) | Just (CaptSub{ c_feeds = feeds } :: ValCapt) <- castVal vv = return . fromP $
+    [: Val (castV v) | v <- concatMapP f_positionals feeds :]
+    +:+ [: Syn "named" [Val (VStr $ cast k), Val (concatNamed v)] | (k, v) <- concatMapP (toP . Map.toList . f_nameds) feeds :]
+    where
+    concatNamed [:x:] = castV x
+    concatNamed xs    = VList (fromP (mapP castV xs))
 interpolateVal val = return [Val val]