Changeset 21673 for src/Pugs/Eval.hs

Timestamp:

08/01/08 13:56:05 (4 months ago)

Author:

audreyt

Message:

* Import Pugs 6.2.13.11 from Hackage into our source tree.
* Highlights:

• Much faster startup time
• Slightly faster compilation time (mostly due to refactored Pugs.AST.Internals)
• Portable-to-Win32 readline thanks to Haskeline

Files:

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

src/Pugs/Eval.hs

@@ -28 +28 @@
 import Prelude hiding ( exp )
 import qualified Data.Map as Map
+import qualified StringTable.AtomMap as AtomMap
 
 import Pugs.AST
@@ -41 +42 @@
 import DrIFT.YAML ()
 import GHC.PArr
-import qualified UTF8 as Buf
+import qualified Data.ByteString.UTF8 as Str
+import qualified Data.ByteString.Char8 as Buf
 
 
@@ -809 +811 @@
     adverbHash  <- reduce adverbs
     let g = ('g' `elem` p5flags || flag_g)
-        p5re = mkRegexWithPCRE (encodeUTF8 str) $
-                    [ pcreUtf8
-                    , ('i' `elem` p5flags || flag_i) `implies` pcreCaseless
-                    , ('m' `elem` p5flags) `implies` pcreMultiline
-                    , ('s' `elem` p5flags) `implies` pcreDotall
-                    , ('x' `elem` p5flags) `implies` pcreExtended
-                    ]
+        mkP5RE = do
+            rv <- compilePCRE compOpts execBlank (encodeUTF8 str)
+            case rv of
+                Left err -> fail (show err)
+                Right rx -> return rx
+            where
+            compOpts = sum
+                [ compUTF8
+                , ('i' `elem` p5flags || flag_i) `implies` compCaseless
+                , ('m' `elem` p5flags) `implies` compMultiline
+                , ('s' `elem` p5flags) `implies` compDotAll
+                , ('x' `elem` p5flags) `implies` compExtended
+                ]
         p6re = combine
             [ if flag_s then (\x -> ":sigspace(1)[" ++ x ++ "]") else id
@@ -825 +833 @@
              | otherwise     = p6reAdvs ++ "::" ++ str
         -}
-        rx | p5 = do ns <- io $ numSubs p5re
-                     return $ MkRulePCRE p5re g ns flag_tilde str adverbHash
+        rx | p5 = mkP5RE >>= \p5re -> return $ MkRulePCRE p5re g (getNumSubs p5re) flag_tilde str adverbHash
            | otherwise = return $ MkRulePGE p6re g flag_tilde adverbHash
-    return . VRule =<< rx
+    io $ fmap VRule rx
     where
     implies True  = id
@@ -1078 +1085 @@
     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 = lengthP vs - 1, lst >= 0 ]
+    argsNam = [ Syn "named" [Val (VStr (cast k)), Val (castV (vs !: lst))] | (k, vs) <- AtomMap.toList (f_nameds feed), let lst = lengthP vs - 1, lst >= 0 ]
     feed = concatFeeds (c_feeds capt)
     inv  = case capt of 
@@ -1115 +1122 @@
         resFeed = feed res
     feed res = maybe emptyFeed id res
-    addNamed :: (Map ID [:a:]) -> VStr -> a -> Map ID [:a:]
+    addNamed :: AtomMap [:a:] -> VStr -> a -> AtomMap [:a:]
     addNamed mp k v =
         let id = cast k in
-        Map.insertWith (flip (+:+)) id [:v:] mp
+        AtomMap.insertWith (flip (+:+)) id [:v:] mp
 
 dummyVar :: Var
@@ -1171 +1178 @@
 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 :]
+    +:+ [: Syn "named" [Val (VStr $ cast k), Val (concatNamed v)] | (k, v) <- concatMapP (toP . AtomMap.toList . f_nameds) feeds :]
     where
     concatNamed [:x:] = castV x