Changeset 15297 for src/Pugs/Eval.hs

Timestamp:

02/18/07 15:59:02 (21 months ago)

Author:

audreyt

Message:

* Revert the previous patch; everything back to normal.

Files:

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

src/Pugs/Eval.hs

@@ -1 @@
-{-# OPTIONS_GHC -fglasgow-exts -cpp -fno-warn-deprecations -fallow-overlapping-instances -foverloaded-strings #-}
+{-# OPTIONS_GHC -fglasgow-exts -cpp -fno-warn-deprecations -fallow-overlapping-instances #-}
 
 {-|
@@ -69 +69 @@
         , envLValue  = False
         , envGlobal  = length (show (padKeys globPad)) `seq` glob -- force eval of all sym names
-        , envPackage = _cast "Main"
+        , envPackage = cast "Main"
         , envClasses = initTree
         , envEval    = evaluate
@@ -95 +95 @@
 runWarn msg = do 
     enterEvalContext CxtVoid $
-        App (_Var "&warn") Nothing [Val (_VStr msg)]
+        App (_Var "&warn") Nothing [Val (VStr msg)]
     return ()
 
@@ -115 +115 @@
 evaluateMain exp = do
     -- S04: INIT {...}*      at run time, ASAP
-    initAV   <- reduceVar $ _cast "@*INIT"
+    initAV   <- reduceVar $ cast "@*INIT"
     initSubs <- fromVals initAV
     enterContext CxtVoid $ do
@@ -123 +123 @@
     tryT (evaluate exp) `finallyM` do
         -- S04: END {...}       at run time, ALAP
-        endAV       <- reduceVar $ _cast "@*END"
+        endAV       <- reduceVar $ cast "@*END"
         endSubs     <- fromVals endAV
-        endMainAV   <- reduceVar $ _cast "@Main::END"
+        endMainAV   <- reduceVar $ cast "@Main::END"
         endMainSubs <- fromVals endMainAV
         enterContext CxtVoid $ do
@@ -143 +143 @@
         Just ref -> do
             want <- asks envWant
-            debug ref (_cast "indent") ('-':) (" Evl [" ++ want ++ "]:\n") exp
+            debug ref (cast "indent") ('-':) (" Evl [" ++ want ++ "]:\n") exp
             val <- local (\e -> e{ envBody = exp }) $ reduce exp
-            debug ref (_cast "indent") (\x -> if null x then [] else tail x) "- Ret: " val
+            debug ref (cast "indent") (\x -> if null x then [] else tail x) "- Ret: " val
             trapVal val (return val)
         Nothing -> do
@@ -270 +270 @@
 
 isStrict :: Eval Bool
-isStrict = fromVal =<< readVar (_cast "$*STRICT")
+isStrict = fromVal =<< readVar (cast "$*STRICT")
 
 -- Reduction for variables
@@ -276 +276 @@
 reduceVar var@MkVar{ v_sigil = sig, v_twigil = twi, v_name = name, v_package = pkg }
     | TAttribute <- twi
-    = reduceSyn (cast $ show sig ++ "{}") [ Syn "{}" [_Var "&self", Val (VStr $ cast name)] ]
+    = reduceSyn (show sig ++ "{}") [ Syn "{}" [_Var "&self", Val (VStr $ cast name)] ]
     | TPrivate <- twi
-    = reduceSyn (cast $ show sig ++ "{}") [ Syn "{}" [_Var "&self", Val (VStr $ cast name)] ]
+    = reduceSyn (show sig ++ "{}") [ Syn "{}" [_Var "&self", Val (VStr $ cast name)] ]
     | otherwise = do
         v <- findVar var
@@ -307 +307 @@
 
 -- XXX - Hack to get context propagating to "return"
-reduceStmts this@(App (Var var) _ _) _ | var == _cast "&return" = reduce this
-reduceStmts this@(Ann _ (App (Var var) _ _)) _ | var == _cast "&return" = reduce this
+reduceStmts this@(App (Var var) _ _) _ | var == cast "&return" = reduce this
+reduceStmts this@(Ann _ (App (Var var) _ _)) _ | var == cast "&return" = reduce this
 
 reduceStmts this rest = do
     let withCxt = case this of
-            App (Var var) _ _         | var == _cast "&yield" -> id
-            Ann _ (App (Var var) _ _) | var == _cast "&yield" -> id
+            App (Var var) _ _         | var == cast "&yield" -> id
+            Ann _ (App (Var var) _ _) | var == cast "&yield" -> id
             _  -> enterContext cxtVoid
     val <- withCxt (reduce this)
@@ -383 +383 @@
 -- Special case: my (undef) is no-op
 reduceSym scope var exp
---  | var == _cast "" = evalExp exp
+--  | var == cast "" = evalExp exp
     | scope <= SMy = do
         ref <- newObject (typeOfSigilVar var)
@@ -418 +418 @@
 enough to make it redundant.
 -}
-reduceSyn :: ID -> [Exp] -> Eval Val
+reduceSyn :: String -> [Exp] -> Eval Val
 
 reduceSyn "()" [exp] = reduce exp
@@ -541 +541 @@
     readRef newAV `finallyM` liftSTM (modifyTVar globTV oldSym)
     where
-    takeVar = _cast "$*TAKE"
+    takeVar = cast "$*TAKE"
 
 reduceSyn "loop" exps = enterLoop $ do
@@ -643 +643 @@
         names <- forM vars $ \var -> case unwrap var of
             Var name -> return name
-            Syn syn [vexp]
-                | [sigil,':',':','(',')'] <- cast syn
-                , Val (VStr name) <- unwrap vexp
-                -> return $ possiblyFixOperatorName (cast (sigil:cast name))
+            Syn [sigil,':',':','(',')'] [vexp]
+                | Val (VStr name) <- unwrap vexp -> return $ possiblyFixOperatorName (cast (sigil:name))
             _        -> retError "Cannot bind this as lhs" var
         bindings <- forM (names `zip` vexps) $ \(var, vexp) -> enterLValue $ do
@@ -729 +727 @@
     -- XXX evil hack for infinite slices
     | [lhs, App (Var var) invs args] <- unwrap exps
-    , var == _cast "&postfix:..."
+    , var == cast "&postfix:..."
     , [idx] <- maybeToList invs ++ args
 --  , not (envLValue env)
     = reduce (Syn "[...]" [lhs, idx])
     | [lhs, App (Var var) invs args] <- unwrap exps
-    , var == _cast "&infix:.."
+    , var == cast "&infix:.."
     , [idx, Val (VNum n)] <- maybeToList invs ++ args
     , n == 1/0
@@ -782 +780 @@
     evalRef ref
 
+reduceSyn (sigil:"::()") exps = do
+    -- These are all parts of the name
+    parts   <- mapM fromVal =<< mapM evalExp exps
+    -- Now we only have to add the sigil in front of the string and join
+    -- the parts with "::".
+    let varname = sigil:(concat . (intersperse "::") $ parts)
+    -- Finally, eval the varname.
+    reduceVar (possiblyFixOperatorName (cast varname))
+
 reduceSyn "{}" [listExp, indexExp] = do
     varVal  <- enterLValue $ enterEvalContext (cxtItem "Hash") listExp
@@ -794 +801 @@
 
 reduceSyn "rx" [exp, adverbs] = do
-    hv      <- fromVal =<< evalExp adverbs :: Eval [(VStr, Val)]
+    hv      <- fromVal =<< evalExp adverbs
     val     <- enterEvalContext (cxtItem "Str") exp
     str     <- fromVal val
@@ -867 +874 @@
     langVal <- evalExp langExp
     lang    <- fromVal langVal
-    when (lang /= ("Haskell" :: String)) $
+    when (lang /= "Haskell") $
         retError "Inline: Unknown language" langVal
     pkg     <- asks envPackage -- full module name here
@@ -882 +889 @@
     retItem $ castV (key, val)
 
-reduceSyn name [lhsExp, rhsExp]
-    | syn <- cast name, last syn == '=' = do
+reduceSyn syn [lhsExp, rhsExp]
+    | last syn == '=' = do
         let op = "&infix:" ++ init syn
         lhs <- enterLValue $ evalExp lhsExp
@@ -929 +936 @@
                 return (sub:rest)
             _         -> return []
-
-reduceSyn name exps | (sigil:"::()") <- cast name = do
-    -- These are all parts of the name
-    parts   <- mapM fromVal =<< mapM evalExp exps
-    -- Now we only have to add the sigil in front of the string and join
-    -- the parts with "::".
-    let varname = sigil:(concat . (intersperse "::") $ parts)
-    -- Finally, eval the varname.
-    reduceVar (possiblyFixOperatorName (_cast varname))
 
 reduceSyn name exps =
@@ -1110 +1108 @@
             af (Just (mconcat (resFeed:c_feeds cap))) args
         | App (Var var) Nothing capExps <- unwrapN
-        , var == _cast "&prefix:|<<" = do
+        , var == cast "&prefix:|<<" = do
             caps    <- mapM castVal =<< fromVals =<< (enterRValue $ enterEvalContext (cxtSlurpy "Capture") (Syn "," capExps))
             af (Just (mconcat (resFeed:concatMap c_feeds caps))) args
@@ -1126 +1124 @@
 
 dummyVar :: Var
-dummyVar = _cast "$"
+dummyVar = cast "$"
 
 chainFun :: Params -> Exp -> Params -> Exp -> [Val] -> Eval Val
@@ -1282 +1280 @@
         tryAnyComprehension pre (pivot:post)
             | App (Var var') _ _    <- unwrap pivot
-            , var' == _cast "&list" = do
+            , var' == cast "&list" = do
                 -- List comprehension!  This:
                 --      1 < list(@x) < 2
@@ -1302 +1300 @@
 applyExp :: SubType -> [ApplyArg] -> Exp -> Eval Val
 applyExp _ bound (Prim f) =
-    f [ argValue arg | arg <- bound, (argName arg) /= _cast "%_" ]
+    f [ argValue arg | arg <- bound, (argName arg) /= cast "%_" ]
 applyExp styp [] body = do
     applyThunk styp [] $ MkThunk (evalExp body) anyType
@@ -1312 +1310 @@
         let name  = dropWhile (not . isAlpha) (cast $ argName arg)
             value = argValue arg
-        evalExp $ Syn "=" [Syn "{}" [Val invocant, Val (_VStr name)], Val value]
+        evalExp $ Syn "=" [Syn "{}" [Val invocant, Val (VStr name)], Val value]
     applyThunk styp normal $ MkThunk (evalExp body) anyType
     where
@@ -1325 +1323 @@
     -- introduce self and $_ as the first invocant.
     inv     <- case styp of
-        SubPointy               -> aliased [_cast "$_"]
-        _ | styp <= SubMethod   -> aliased [_cast "&self"] -- , "$_"]
+        SubPointy               -> aliased [cast "$_"]
+        _ | styp <= SubMethod   -> aliased [cast "&self"] -- , "$_"]
         _                       -> return []
     pad <- formal