diff --git a/BUGS.ja.utf-8 b/BUGS.ja.utf-8 new file mode 100644 --- /dev/null +++ b/BUGS.ja.utf-8 @@ -0,0 +1,4 @@ +2008.1.20 Sun. +(?i)と[...]の組み合わせがうまくない。 +[...]に関してはどうもうまくない感じがする。 +あとで根本的な解決が必要だ。 diff --git a/Hidden/ParseLibCore.hs b/Hidden/ParseLibCore.hs --- a/Hidden/ParseLibCore.hs +++ b/Hidden/ParseLibCore.hs @@ -9,7 +9,7 @@ module Hidden.ParseLibCore ( Parse , runParse -, MonadParse(spot, spotBack, still, parseNot, askHere) +, MonadParse(spot, spotBack, still, parseNot, askHere, noBacktrack) , MonadPlus(mzero, mplus) , MonadReader(ask, local) ) where @@ -25,11 +25,12 @@ import Data.Monoid ( Monoid(mempty) ) class Monad m => MonadParse a m | m -> a where - spot :: (a -> Bool) -> m a - spotBack :: (a -> Bool) -> m a - still :: m b -> m b - parseNot :: b -> m b -> m b - askHere :: m ([a],[a]) + spot :: (a -> Bool) -> m a + spotBack :: (a -> Bool) -> m a + still :: m b -> m b + parseNot :: b -> m b -> m b + askHere :: m ([a],[a]) + noBacktrack :: m b -> m b instance (MonadParse a m) => MonadParse a (ReaderT s m) where spot = lift . spot @@ -37,6 +38,7 @@ still = mapReaderT still parseNot x p = ReaderT $ \r -> parseNot x (runReaderT p r) askHere = lift askHere + noBacktrack = mapReaderT noBacktrack instance (MonadParse a m, Monoid w) => MonadParse a (WriterT w m) where spot = lift . spot @@ -44,6 +46,7 @@ still = mapWriterT still parseNot x p = WriterT $ parseNot (x, mempty) (runWriterT p) askHere = lift askHere + noBacktrack = mapWriterT noBacktrack instance (MonadParse a m) => MonadParse a (StateT r m) where spot = lift . spot @@ -51,6 +54,7 @@ still = mapStateT still parseNot x p = StateT $ \s -> parseNot (x,s) (runStateT p s) askHere = lift askHere + noBacktrack = mapStateT noBacktrack newtype Parse a b = Parse { runParse :: ([a],[a]) -> [(b,([a],[a]))] } @@ -77,6 +81,7 @@ [] -> [(x,inp)] _ -> [] askHere = ask + noBacktrack p = Parse $ (:[]) . head . runParse p instance Monad (Parse a) where return = Parse . \val inp -> [(val,inp)] diff --git a/Hidden/ParseRegexStr.hs b/Hidden/ParseRegexStr.hs --- a/Hidden/ParseRegexStr.hs +++ b/Hidden/ParseRegexStr.hs @@ -20,7 +20,7 @@ toUpper, toLower ) import Data.Ix ( inRange ) import Hidden.SrcRegActList( plusesList, oneCharList, backSlashesList, - parensesList, charClassList ) + parensesList, charClassList, selfList ) parseRegexStr :: String -> [RegexAction] parseRegexStr = @@ -86,6 +86,8 @@ do { x <- isModeX; if x then parseTokenX else mzero } `mplus` parseOneChar oneCharList + `mplus` + ( foldr mplus mzero $ map ((>>= return . Select . (==)) . token) selfList ) `mplus` parseBackSlashes backSlashesList `mplus` diff --git a/Hidden/RegexPRCore.hs b/Hidden/RegexPRCore.hs --- a/Hidden/RegexPRCore.hs +++ b/Hidden/RegexPRCore.hs @@ -8,11 +8,11 @@ ) where import Hidden.RegexPRTypes ( RegexParser, MatchList, runRegexParser ) -import Hidden.ParseLib ( spot, spotBack, still, parseNot, - build, tokens, tokensBack, - repeatParse, greedyRepeatParse, - beginningOfInput, endOfInput, - MonadPlus(..), (>++>) ) +import Hidden.ParseLib ( spot, spotBack, still, noBacktrack, parseNot, + build, tokens, tokensBack, + repeatParse, greedyRepeatParse, + beginningOfInput, endOfInput, + MonadPlus(..), (>++>) ) import Hidden.ParseRegexStr ( RegexAction(..), parseRegexStr ) import Control.Monad.State ( StateT, runStateT, gets, modify, lift, liftM ) import Control.Monad.Reader( ask ) @@ -65,6 +65,7 @@ Parens acts -> mkRegexParser isBack acts Comment _ -> return "" NopRegex -> return "" + NoBacktrack acts -> noBacktrack $ mkRegexParser isBack acts >++> mkRegexParser isBack ras where selectParserFB = if isBack then selectParserBack else selectParser diff --git a/Hidden/RegexPRTypes.hs b/Hidden/RegexPRTypes.hs --- a/Hidden/RegexPRTypes.hs +++ b/Hidden/RegexPRTypes.hs @@ -66,7 +66,8 @@ RegActNot [RegexAction] | BeginningOfInput | EndOfInput | PreMatchPoint | Parens [RegexAction] | - Comment String | NopRegex + Comment String | NopRegex | + NoBacktrack [RegexAction] reverseRegexAction :: RegexAction -> RegexAction reverseRegexAction (Note i ras) diff --git a/Hidden/SrcRegActList.hs b/Hidden/SrcRegActList.hs --- a/Hidden/SrcRegActList.hs +++ b/Hidden/SrcRegActList.hs @@ -9,6 +9,7 @@ , backSlashesList , parensesList , charClassList +, selfList ) where import Hidden.RegexPRTypes( RegexAction(..), reverseRegexAction ) @@ -27,15 +28,18 @@ , ( "??", RepeatNotGreedy 0 $ Just 1 ) ] +selfList :: [ Char ] +selfList = ", <>-!:#@\n" + oneCharList :: [ (Char, RegexAction) ] oneCharList = [ ('.', Select (/='\n')) , ('$', RegexOr [EndOfInput] [Still [Select (=='\n')]]) , ('^', RegexOr [BeginningOfInput] [Still [Backword [Select (=='\n')]]]) - , (',', Select (==',')) - , (' ', Select (==' ')) - , ('<', Select (=='<')) - , ('>', Select (=='>')) +-- , (',', Select (==',')) +-- , (' ', Select (==' ')) +-- , ('<', Select (=='<')) +-- , ('>', Select (=='>')) ] backSlashesList :: [ (Char, RegexAction) ] @@ -67,9 +71,13 @@ parensesList :: [ (String, [RegexAction] -> RegexAction) ] parensesList = [ ( "?<=", Still . (:[]) . Backword . reverse . map reverseRegexAction ) + , ( "?", NoBacktrack ) + , ( "$>", NoBacktrack ) ] charClassList :: [ (String, Char -> Bool) ] diff --git a/Hidden/TestMain.hs b/Hidden/TestMain.hs --- a/Hidden/TestMain.hs +++ b/Hidden/TestMain.hs @@ -159,5 +159,16 @@ , Just ( ("\227\129\130", ("", "")), [] ) ~=? matchRegexPR "\227\129\130" "\227\129\130" - , "abc!abc!abc!bc" ~=? gsubRegexPR "(?ixm) aBc . # comment " "abc!" "abc\nABCDAbcAbc" + , "abc!abc!abc!bc" ~=? + gsubRegexPR "(?ixm) aBc . # comment " "abc!" "abc\nABCDAbcAbc" + , Just ( ("FGH-12345", ("abcDE", "67")), [] ) + ~=? + matchRegexPR "[A-Z]{3}-\\d{5}" "abcDEFGH-1234567" +-- , Just ( ("ABc", ("", " de")), [] ) ~=? matchRegexPR "(?i)[A-Z]+" "ABcde" +-- , Just ( ("?", ("", "!abc")), [] ) ~=? matchRegexPR "[\\--z]*" "?!abc" +-- , Just ( ("?!abc-A", ("", " b")), [] ) ~=? matchRegexPR "[!-z]*" "?!abc-A b" + , Just ( ("!!:!", ("!", "!!")), [] ) ~=? + matchRegexPR "(?<=!)!{1,3}:!(?=!)" "!!!:!!!" + , Nothing ~=? matchRegexPR "(?>a*)ab" "aaab" + , Just ( ("\n\n", ("abc", "def")), [] )~=? matchRegexPR "\n\n" "abc\n\ndef" ] diff --git a/TODO.ja.utf-8 b/TODO.ja.utf-8 --- a/TODO.ja.utf-8 +++ b/TODO.ja.utf-8 @@ -17,3 +17,18 @@ \08とかについて (?> ) 日本語(UTF-8)対応。 + +2008.1.20 Sun. +正規表現のparseに失敗したときのerror messageの改善。 +subで使える表現の追加。 + +(?> )は実装。 + +TODO LIST + (? ( (ret, (pre, rest)), ml ) ) $ matchRegexPRVerbose reg ("", str) +gmatchRegexPR :: String -> String -> [ ( RegexResult, MatchList ) ] +gmatchRegexPR reg str = gmatchRegexPRGen Nothing reg ("", str) + +gmatchRegexPRGen :: + Maybe (String, String) -> String -> (String, String) -> [ ( RegexResult, MatchList ) ] +gmatchRegexPRGen pmp reg str + = case matchRegexPRVerbose reg str of + Just ((pre, ret, sp@(p,rest@(~(x:xs)))), ml) + -> case (pmp, sp) of + (Just (_, ""), _) -> [ ( (ret, (pre, rest)), ml ) ] + _ | Just sp == pmp -> ( (ret, (pre, rest)), ml ) : + gmatchRegexPRGen pmp reg (x:p, xs) + | otherwise -> ( (ret, (pre, rest)), ml ) : + gmatchRegexPRGen (Just sp) reg sp + Nothing -> [] + subRegexPR :: String -> String -> String -> String subRegexPR reg sub src = case matchRegexPRVerbose reg ("",src) of Just al@((pre, _, sp), _) -> pre ++ subBackRef al sub ++ snd sp - Nothing -> src + Nothing -> src gsubRegexPR :: String -> String -> String -> String gsubRegexPR reg sub src = gsubRegexPRGen Nothing reg sub ("", src) diff --git a/regexpr.cabal b/regexpr.cabal --- a/regexpr.cabal +++ b/regexpr.cabal @@ -1,5 +1,5 @@ Name: regexpr -Version: 0.2.3 +Version: 0.2.5 License: GPL License-File: LICENSE Author: Yoshikuni Jujo @@ -28,6 +28,9 @@ . gsubRegexPR "(?ixm) aBc . # comment \n\n" "abc!" "abc\nABCDAbcAbc" => "abc!abc!abc!bc" + . + gmatchRegexPR "(?=(? + [(("abc", ("", "defdefabc")), []), (("abc", ("defdef", "")), [])] Category: Text Build-Depends: base, mtl, HUnit Build-Type: Simple @@ -36,5 +39,5 @@ Hidden.ParseLibCore, Hidden.RegexPRCore, Hidden.ParseRegexStr, Hidden.SrcRegActList, Hidden.TestMain -Extra-source-files: TODO.ja.utf-8, localConfigure +Extra-source-files: TODO.ja.utf-8, localConfigure, BUGS.ja.utf-8 ghc-options: -Wall -O2 -optl-Wl,-s