Changeset 6109

Timestamp:

08/07/05 20:12:10 (3 years ago)

Author:

putter

Message:

PCRE :global rules, without a subpattern, now return the correct match array. my @a = 'aaa' rx:perl5:g/a/; +@a #=> 3, not 0. PGE rules are not fixed, awaiting a way to determine if they contain a subpattern. Match .from and .to still incorrect. The patch is a bit messy. This would all be better handled by p6-side analysis and implementation of :global.

Location:

src

Files:

• Pugs/AST/Internals.hs (modified) (1 diff)
• Pugs/Eval.hs (modified) (3 diffs)
• Pugs/Prim/Match.hs (modified) (2 diffs)
• RRegex/PCRE.hs (modified) (2 diffs)

src/Pugs/AST/Internals.hs

@@ -1651 +1651 @@
                                 --     'Regex' object)
         , rxGlobal    :: !Bool  -- ^ Flag indicating \'global\' (match-all)
+        , rxNumSubs   :: !Int   -- ^ The number of subpatterns present.
             , rxStringify :: !Bool
         , rxRuleStr   :: !String -- ^ The rule string, for user reference.

src/Pugs/Eval.hs

@@ -40 +40 @@
 import Pugs.External
 import Pugs.Eval.Var
+
+import RRegex.PCRE as PCRE
 
 {-|
@@ -633 +635 @@
     flag_s  <- fromAdverb hv ["stringify"] -- XXX hack
     adverbHash <- reduce adverbs
-    let rx | p5 = MkRulePCRE p5re g flag_s str adverbHash
+    let 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
+                    ]
+    ns <- liftIO $ PCRE.numSubs p5re
+    let rx | p5 = MkRulePCRE p5re g ns flag_s str adverbHash
            | otherwise = MkRulePGE p6re g flag_s adverbHash
         g = ('g' `elem` p5flags || flag_g)
@@ -640 +650 @@
                       ':':_ -> ":w"   ++ str
                       _     -> ":w::" ++ str
-        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
-                    ]
     retVal $ VRule rx
     where

src/Pugs/Prim/Match.hs

@@ -144 +144 @@
             else return (VList rv)
     where
+    hasSubpatterns = case rx of
+        MkRulePGE{}             -> True -- bogus
+        MkRulePCRE{rxNumSubs=n} -> not (n == 0)
     matchOnce :: String -> Eval [Val]
     matchOnce str = do
@@ -149 +152 @@
         if not (matchOk match) then return [] else do
         rest <- matchOnce (genericDrop (matchTo match) str)
-        return $ matchSubPos match ++ rest
+        return $ if hasSubpatterns
+                 then (matchSubPos match) ++ rest
+                 else (VMatch match):rest
 
 op2Match x (VRule rx) = do

src/RRegex/PCRE.hs

@@ -23 +23 @@
     pcreUtf8,       --  UTF-8 semantics
     
+    numSubs,
+
     getVersion
     ) where
@@ -59 +61 @@
             return $ Left (fi eo,es)
           else fmap (Right . Regex) (newForeignPtr_ v)
+
+numSubs :: Regex -> IO Int
+numSubs (Regex pcre_fptr) = withForeignPtr pcre_fptr $ \pcre_ptr -> do
+    nsub <- getNumSubs pcre_ptr 
+    return $ fromIntegral nsub
 
 getNumSubs :: Ptr PCRE -> IO CInt