Changeset 15296 for src/Pugs/Eval

Timestamp:

02/18/07 15:56:10 (21 months ago)

Author:

audreyt

Message:

* Convert VStr from String to ByteString?, and Syn from

String to ID, in Pugs. Benchmark shows the perf gain is 5%,
so it's not worth the trouble of writing a GHC 6.7-compatible
processor. The next commit will revert this commit.

Files:

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

src/Pugs/Eval/Var.hs

@@ -1 @@
-{-# OPTIONS_GHC -fglasgow-exts -cpp -fallow-overlapping-instances -funbox-strict-fields #-}
+{-# OPTIONS_GHC -fglasgow-exts -cpp -fallow-overlapping-instances -funbox-strict-fields -foverloaded-strings #-}
 
 module Pugs.Eval.Var (
@@ -43 +43 @@
             retError "no such ENV variable" name
         _           -> do
-            rv   <- enterLValue (evalExp $ Syn "{}" [_Var "%*ENV", Val (VStr $ cast name)])
+            rv   <- enterLValue (evalExp $ _Syn "{}" [_Var "%*ENV", Val (VStr $ cast name)])
             tvar <- liftSTM . newTVar =<< fromVal rv
             return (Just tvar)
@@ -98 +98 @@
         vref   <- liftSTM (readTVar tvref)
         let val = VRef vref
-        return (cast key, val)
+        return (__(cast key), val)
     padEntryToHashEntry (_, []) = fail "Nonexistant var in pad?"
 
@@ -466 +466 @@
         meta    <- readRef ref
         fetch   <- doHash meta hash_fetchVal
-        fmap (map (cast :: String -> Pkg)) (fromVal =<< fetch "is")
+        fmap (map (cast :: VStr -> Pkg)) (fromVal =<< fetch "is")
 
 {-|
@@ -491 +491 @@
     return $ subReturns sub
 inferExpType (App (Var var) (Just inv) _)
-    | var == cast "&new"
+    | var == _cast "&new"
     = inferExpType $ unwrap inv
 inferExpType (App (Var name) invs args) = do
@@ -548 +548 @@
 magicalMap :: Map Var (Eval (Maybe Val))
 magicalMap = Map.fromList
-    [ (cast "$?FILE"     , posSym posName)
-    , (cast "$?LINE"     , posSym posBeginLine)
-    , (cast "$?COLUMN"   , posSym posBeginColumn)
-    , (cast "$?POSITION" , posSym pretty)
-    , (cast "$?MODULE"   , constSym "Main")
-    , (cast "$?OS"       , constSym (getConfig "osname"))
-    , (cast "$?CLASS"    , fmap (Just . VType . cast) (asks envPackage))
-    , (cast ":?CLASS"    , fmap (Just . VType . cast) (asks envPackage))
-    , (cast "$?PACKAGE"  , fmap (Just . VType . cast) (asks envPackage))
-    , (cast ":?PACKAGE"  , fmap (Just . VType . cast) (asks envPackage))
-    , (cast "$?ROLE"     , fmap (Just . VType . cast) (asks envPackage))
-    , (cast ":?ROLE"     , fmap (Just . VType . cast) (asks envPackage))
+    [ (_cast "$?FILE"     , posSym posName)
+    , (_cast "$?LINE"     , posSym posBeginLine)
+    , (_cast "$?COLUMN"   , posSym posBeginColumn)
+    , (_cast "$?POSITION" , posSym pretty)
+    , (_cast "$?MODULE"   , constSym "Main")
+    , (_cast "$?OS"       , constSym (getConfig "osname"))
+    , (_cast "$?CLASS"    , fmap (Just . VType . cast) (asks envPackage))
+    , (_cast ":?CLASS"    , fmap (Just . VType . cast) (asks envPackage))
+    , (_cast "$?PACKAGE"  , fmap (Just . VType . cast) (asks envPackage))
+    , (_cast ":?PACKAGE"  , fmap (Just . VType . cast) (asks envPackage))
+    , (_cast "$?ROLE"     , fmap (Just . VType . cast) (asks envPackage))
+    , (_cast ":?ROLE"     , fmap (Just . VType . cast) (asks envPackage))
     ]
 
@@ -566 +566 @@
 
 constSym :: String -> Eval (Maybe Val)
-constSym = return . Just . VStr
+constSym = return . Just . _VStr
 
 findSyms :: Var -> Eval [(Var, Val)]