deepseq-bounded 0.6.1.0 → 0.6.2.0
raw patch · 4 files changed
+13/−574 lines, 4 filesdep −attoparsecdep −bytestringdep −textPVP ok
version bump matches the API change (PVP)
Dependencies removed: attoparsec, bytestring, text
API changes (from Hackage documentation)
Files
- changelog.txt +6/−2
- deepseq-bounded.cabal +1/−31
- src/Control/DeepSeq/Bounded/Compile_new_grammar.hs +6/−452
- src/Control/DeepSeq/Bounded/Compile_shared_utils2.hs +0/−89
changelog.txt view
@@ -9,6 +9,10 @@ http://www.fremissant.net/deepseq-bounded/transition-5-6-7.html (most up to date). +0.6.1.0 -> 0.6.2.0+ - everything relating to attoparsec has been ripped out+ - quite a bit lighter on the dependencies as a result+ 0.6.0.3 -> 0.6.1.0 - now have an H98 parser for the new grammar, and it's quite a bit shorter than the attoparsec@@ -19,8 +23,8 @@ path correctly, to use it) - flanking whitespace within type constraints lists is now accepted (ignored)- - whitespace is not preserved beyond the parser; the need would- have to be demonstrated to support that+ - whitespace is not preserved beyond the parser; the need would+ have to be demonstrated to support that - yet further decrufting of Compile_new_grammar.hs 0.6.0.2 -> 0.6.0.3
deepseq-bounded.cabal view
@@ -2,7 +2,7 @@ ------------------------------------------------------------------------------- name: deepseq-bounded-version: 0.6.1.0+version: 0.6.2.0 synopsis: Bounded deepseq, including support for generic deriving license: BSD3 license-file: LICENSE@@ -146,12 +146,6 @@ --Default: False Manual: True -Flag USE_ATTOPARSEC- Description: When True, depend on and use attoparsec for implementing the Pattern parser. (Probably, this flag will be removed in 0.7, becoming effectively always True.) Unfortunately, attoparsec also requires text, so if you're building in a sandbox this will account for most of your initial build time, but it's a one-time cost. Also, we need an alternative parser for HASKELL98_FRAGMENT, since attoparsec isn't H98... Later: Now that have an H98 parser, not sure there's any reason to /keep/ the atto parser! String patterns are never expected to be long, and parsing string patterns is never expected to be part of a tight loop; and furthermore, NFDataP is the most feature-rich, but least performance-oriented, of the forcing facilities of deepseq-bounded.---Default: True- Default: False- Manual: True- -- Flag DEPTH_USES_INT64 -- Description: This won't be implemented for a while, probably. -- --Default: True@@ -410,19 +404,6 @@ else cpp-options: -DUSE_SOP=0 - -- XXX No attoparsec parser was built (yet, anyway) for the old grammar.- if flag(NEW_IMPROVED_PATTERN_GRAMMAR)- if ! flag(HASKELL98_FRAGMENT)- if flag(USE_ATTOPARSEC)- build-depends:- -- attoparsec also brings in text (and a few other things)...- -- probably too tight:- attoparsec == 0.12.*- -- probably too tight:- , text == 1.2.*- -- probably too tight:- , bytestring == 0.10.*- if flag(HASKELL98_FRAGMENT) cpp-options: -DHASKELL98_FRAGMENT=1 else@@ -432,17 +413,6 @@ cpp-options: -DNEW_IMPROVED_PATTERN_GRAMMAR=1 else cpp-options: -DNEW_IMPROVED_PATTERN_GRAMMAR=0-- if flag(NEW_IMPROVED_PATTERN_GRAMMAR)- if ! flag(HASKELL98_FRAGMENT)- if flag(USE_ATTOPARSEC)- cpp-options: -DUSE_ATTOPARSEC=1- else- cpp-options: -DUSE_ATTOPARSEC=0- else- cpp-options: -DUSE_ATTOPARSEC=0- else- cpp-options: -DUSE_ATTOPARSEC=0 --if flag(DEPTH_USE_INT64) -- cpp-options: -DDEPTH_USE_INT64=1
src/Control/DeepSeq/Bounded/Compile_new_grammar.hs view
@@ -11,14 +11,6 @@ ------------------------------------------------------------------------------- -#if USE_ATTOPARSEC- {-# LANGUAGE OverloadedStrings #-}- {- LANGUAGE ScopedTypeVariables #-} -- debugging only- {-# LANGUAGE BangPatterns #-} -- for forcing tracelines in do blocks-#endif---------------------------------------------------------------------------------- -- | -- Module : Control.DeepSeq.Bounded.Compile_new_grammar -- Copyright : Andrew G. Seniuk 2014-2015@@ -26,7 +18,7 @@ -- -- Maintainer : Andrew Seniuk <rasfar@gmail.com> -- Stability : provisional--- Portability : attoparsec+-- Portability : portable (H98) -- -------------------------------------------------------------------------------@@ -34,15 +26,7 @@ module Control.DeepSeq.Bounded.Compile_new_grammar ( -#if USE_ATTOPARSEC-#if HASKELL98_FRAGMENT-#error Sorry, HASKELL98_FRAGMENT incompatible with USE_ATTOPARSEC.-#endif- compileUsingAttoparsec ,--- parsePat ,-#else compilePat' ,-#endif ) where@@ -59,24 +43,6 @@ import Debug.Trace ( trace ) -#if USE_ATTOPARSEC-- import qualified Data.Attoparsec.Text as AT- import qualified Data.Text as T- import Control.Applicative-- import Data.Char ( isLetter )- import Data.Char ( isDigit )- import Data.Char ( ord )-- import Control.Monad ( liftM )---import Control.Monad ( foldM )---import Data.Foldable ( fold )- import Control.Monad ( mzero )- import Data.Monoid ( mempty )--#else- import Control.DeepSeq.Bounded.PatUtil ( liftPats ) import Data.Char ( isSpace ) import Data.Char ( isLower )@@ -84,8 +50,6 @@ import Data.Char ( ord ) import Data.Maybe ( isJust ) -#endif- ------------------------------------------------------------------------------- #if DO_TRACE@@ -94,400 +58,9 @@ mytrace _ = id #endif -#if USE_ATTOPARSEC----------------------------------------------------------------------------------- -- The caller (or someone up there) uses liftPat if- -- multiple patterns are parsed (adds new common root).- parsePatsTop :: AT.Parser [Pattern]- parsePatsTop = do- !_ <- mytrace ("parsePatsTop.") $ return ()- let as = emptyPatNodeAttrs- AT.many' (AT.skipSpace *> parsePat as <* AT.skipSpace)----------------------------------------------------------------------------------- -- This differs from parsePatsTop in that it assumes an- -- opening grouping token has been consumed (so will be- -- expecting a corresponding closing token).- parsePats :: AT.Parser [Pattern]-#if 1- parsePats = do- !_ <- mytrace "parsePats." $ return ()- (AT.endOfInput *> pure [])- <|> (do- c <- AT.peekChar'-#if USE_CURLY_BRACE_INSTEAD_OF_PAREN_FOR_SUBPATTERNS- if c == '}'-#else- if c == ')'-#endif- then pure []---- then AT.char '}' >> pure []- else let as = emptyPatNodeAttrs in- AT.many' (AT.skipSpace *> parsePat as <* AT.skipSpace))-#else- -- XXX Why does this work so badly?- parsePats = AT.manyTill'- (AT.skipSpace *> parsePat emptyPatNodeAttrs)- (AT.endOfInput <|> (AT.char ')' *> return ()))-#endif----------------------------------------------------------------------------------- -- Test if next character is non-attribute, up front,- -- and skip all this attribute stuff in that case!...- parsePat :: PatNodeAttrs -> AT.Parser Pattern- parsePat as = do- !_ <- mytrace "parsePat." $ return ()- let modchars = ":@=>+^/%"- mc <- AT.peekChar- let c = fromJust mc- if isNothing mc- then fail "parse_type_constraints: unexpected end-of-input"- else if c `elem` modchars- then parsePatAttributes as- else parsePat3 as-- -- Note: Previously, type constraint was handled in a more- -- ad hoc manner. The existence of separate T* nodes is- -- evidence of this, but those will likely be removed in 0.7,- -- making type constraint just another attribute of W* nodes.- parsePatAttributes :: PatNodeAttrs -> AT.Parser Pattern- parsePatAttributes as = do- !_ <- mytrace "parsePatAttributes." $ return ()- foldr (<|>) mempty $--- foldM (<|>) mempty $--- fold (<|>) mempty $--- fold (<|>) mzero $- ( map- ( \ (c,s,p,b,a)- -> do - let q = (c,s,b,a)- if c == '\0'- then fail ""- else p c b a s <* AT.skipSpace- )- -- doConstrainType, doDelay, and doPseq handled specially,- -- due to their taking arguments.- [- ( '\0' , "" , dud_parser , const False , as )- , ( ':' , "types" , types_parser , doConstrainType , as_types )- , ( '@' , "delay" , delay_parser , doDelay , as_delay )-#if USE_PAR_PATNODE- , ( '=' , "spark" , no_arg_parser , doSpark , as_spark )-#endif-#if USE_PSEQ_PATNODE- , ( '>' , "pseq" , pseq_parser , doPseq , as_pseq )-#endif-#if USE_TRACE_PATNODE- , ( '+' , "trace" , no_arg_parser , doTrace , as_trace )-#endif-#if USE_PING_PATNODE- , ( '^' , "ping" , no_arg_parser , doPing , as_ping )-#endif-#if USE_DIE_PATNODE- , ( '/' , "die" , no_arg_parser , doDie , as_die )-#endif-#if USE_TIMING_PATNODE- , ( '%' , "timing" , no_arg_parser , doTiming , as_timing )-#endif- ]- ) ++ [ parsePat3 as ]- where- dud_parser _ _ _ _ = fail "dud_parser" -- (is never run; should use Proxy)- no_arg_parser c b a s = do- ( (AT.char c) <* AT.skipSpace )- >> (if b as- then fail $ "compilePat: duplicate "- ++ show c ++ " (" ++ s ++ ") "- ++ "node attribute"- else parsePat a)- types_parser _ _ a _ = parsePat1''' a- delay_parser _ _ a _ = parsePat1' a- pseq_parser _ _ a _ = parsePat1'' a- as_types = as { doConstrainType = True }- as_delay = as { doDelay = True }-#if USE_PAR_PATNODE- as_spark = as { doSpark = True }-#endif-#if USE_PSEQ_PATNODE- as_pseq = as { doPseq = True }-#endif-#if USE_TRACE_PATNODE- as_trace = as { doTrace = True }-#endif-#if USE_PING_PATNODE- as_ping = as { doPing = True }-#endif-#if USE_DIE_PATNODE- as_die = as { doDie = True }-#endif-#if USE_TIMING_PATNODE- as_timing = as { doTiming = True }-#endif-- -- Parse the ":Int;Maybe Float:" typeConstraints attribute, if present.- parsePat1''' :: PatNodeAttrs -> AT.Parser Pattern- parsePat1''' as = do- !_ <- mytrace "parsePat1'''." $ return ()- AT.char ':'- >> ( ( parse_type_constraints <* AT.skipSpace )- >>= \ tcs -> let as' = as { doConstrainType = True- , typeConstraints = map T.unpack tcs }- in parsePat as' )-- -- Parse the "@50000" delayus attribute, if present.- parsePat1' :: PatNodeAttrs -> AT.Parser Pattern- parsePat1' as = do- !_ <- mytrace "parsePat1'." $ return ()- AT.char '@'- >> ( ( AT.decimal <* AT.skipSpace )- >>= \ dly -> let as' = as { doDelay = True- , delayus = dly }- in parsePat as' )--#if USE_PSEQ_PATNODE- -- Parse the ">cdba" pseqPerm attribute, if present.- parsePat1'' :: PatNodeAttrs -> AT.Parser Pattern- parsePat1'' as = do- !_ <- mytrace "parsePat1''." $ return ()- AT.char '>'- >> ( ( AT.many1' AT.letter ) <* AT.skipSpace- >>= \ perm -> let perm' = map (\c -> ord c - ord 'a') perm- as' = as { doPseq = True- , pseqPerm = Just perm' }- in parsePat as' )-#endif----------------------------------------------------------------------------------- -- Handle "*23"-style (WN and TN) nodes.- parsePat3 :: PatNodeAttrs -> AT.Parser Pattern- parsePat3 as = do- !_ <- mytrace "parsePat3." $ return ()- b <- AT.peekChar'-#if ( ! ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_NUMBER_ALONE__SAFE_ONLY_TO_DEPTH_19 ) && ( ! ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_SINGLE_DIGIT__CAN_ONLY_EXPRESS_DOWN_TO_DEPTH_9 )- AT.anyChar- if b == '*'-#else- if isDigit b-#endif- then do ( (parsePat3_aux b as)- <|> (do-#if ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_NUMBER_ALONE__SAFE_ONLY_TO_DEPTH_19 || ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_SINGLE_DIGIT__CAN_ONLY_EXPRESS_DOWN_TO_DEPTH_9-#if 1-#if ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_SINGLE_DIGIT__CAN_ONLY_EXPRESS_DOWN_TO_DEPTH_9- AT.anyChar- (case b of- '0' -> parsePat4 '0' Nothing as- '1' -> parsePat4 '1' Nothing as- _ -> parsePat4 '*' Nothing as- ) ) )-#else- (parsePat4 '*' Nothing as) ) )-#endif-#else- fail $ "parsePat3: unexpected digit " ++ [b] ) )-#endif-#else- (parsePat4 '*' Nothing as) ) )-#endif- else do-#if ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_NUMBER_ALONE__SAFE_ONLY_TO_DEPTH_19 || ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_SINGLE_DIGIT__CAN_ONLY_EXPRESS_DOWN_TO_DEPTH_9--- fail $ "parsePat3: #2 unexpected digit " ++ [b]- AT.anyChar-#endif- parsePat4 b Nothing as-- -- Actual handler, in case it /was/ WN or TN node.- parsePat3_aux :: Char -> PatNodeAttrs -> AT.Parser Pattern- parsePat3_aux b as = do- !_ <- mytrace "parsePat3_aux." $ return ()--- These should be safe cutoffs without having to worry about exact figures.---- DEPTH_USES_INT64 isn't implemented yet, this is just a note---- for future consideration. (Should be in NFDataN if anywhere...).---- I'm not ready to make this sweeping change yet.---- #if DEPTH_USES_INT64---- if length n_integer_str > 19 = fail $ "compilePat: *" ++ n_integer_str ++ " is too large"-#if ( ! ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_NUMBER_ALONE__SAFE_ONLY_TO_DEPTH_19 ) && ( ! ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_SINGLE_DIGIT__CAN_ONLY_EXPRESS_DOWN_TO_DEPTH_9 )- AT.skipSpace-#endif-#if ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_NUMBER_ALONE__SAFE_ONLY_TO_DEPTH_19- n_integer_cs <- if b == '1'- then AT.anyChar *> AT.option "1" (AT.digit >>= \ c -> return ('1':[c]))- else AT.anyChar *> return [b]- let n_integer = read n_integer_cs :: Integer-#elif ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_SINGLE_DIGIT__CAN_ONLY_EXPRESS_DOWN_TO_DEPTH_9- n_integer_c <- AT.anyChar :: AT.Parser Char- n_integer <- case n_integer_c of- '0' -> mytrace ("ANDDD...(0):") $ fail ""- '1' -> mytrace ("ANDDD...(1):") $ fail ""- _ -> parsePat4 '*' Nothing as- let n_integer = read [n_integer_c] :: Integer-#else- n_integer <- AT.decimal :: AT.Parser Integer-#endif- let n_integer_str = show n_integer- if length n_integer_str > 9- then fail $ "compilePat: *" ++ n_integer_str ++ " is too large"- else parsePat4 '*' (Just (read n_integer_str :: Int)) as----------------------------------------------------------------------------------- -- This handles whether or not it's a type-constrainted node.- -- (The constraints themselves will have already been parsed.)- parsePat4 :: Char -> Maybe Int -> PatNodeAttrs -> AT.Parser Pattern- parsePat4 b mdepth as = do- !_ <- mytrace "parsePat4." $ return ()- if doConstrainType as- then parsePat4_t b mdepth as- else parsePat4_w b mdepth as-- -- Actual handler, in case it was /NOT/ a type-constrained node;- -- i.e. a WI, WR, WS (if still exists), WN or WW node.- parsePat4_w :: Char -> Maybe Int -> PatNodeAttrs -> AT.Parser Pattern- parsePat4_w b mdepth as = do- !_ <- mytrace "parsePat4_w." $ return ()- case b of-#if ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_SINGLE_DIGIT__CAN_ONLY_EXPRESS_DOWN_TO_DEPTH_9- '0' -> return (Node (WI as) [])-#else- '.' -> return (Node (WI as) [])-#endif-#if ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_SINGLE_DIGIT__CAN_ONLY_EXPRESS_DOWN_TO_DEPTH_9- '1' -> return (Node (WS as) [])-#else- '!' -> return (Node (WS as) [])-#endif- '*' -> if isNothing mdepth- then return (Node (WW as) [])- else return (Node (WN as_n) [])-#if USE_CURLY_BRACE_INSTEAD_OF_PAREN_FOR_SUBPATTERNS- '{' -> parsePat_WRTR_tail False b as-#else- '(' -> parsePat_WRTR_tail False b as-#endif-#if USE_CURLY_BRACE_INSTEAD_OF_PAREN_FOR_SUBPATTERNS- _ -> fail $ "compilePat: expected one of \".!*{\" (got " ++ show b ++ ")"-#else- _ -> fail $ "compilePat: expected one of \".!*(\" (got " ++ show b ++ ")"-#endif- where- as_n = as { depth = fromJust mdepth }-- -- This is a helper of patsePat4_aux.- parsePat4_t :: Char -> Maybe Int -> PatNodeAttrs -> AT.Parser Pattern- parsePat4_t b mdepth as_t = do- !_ <- mytrace "parsePat4_t." $ return ()- case b of-#if USE_CURLY_BRACE_INSTEAD_OF_PAREN_FOR_SUBPATTERNS- '{' -> do-#else- '(' -> do-#endif- parsePat_WRTR_tail True 'x' as_t-#if ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_SINGLE_DIGIT__CAN_ONLY_EXPRESS_DOWN_TO_DEPTH_9- '0' -> return (Node (TI as_t) [])-#else- '.' -> return (Node (TI as_t) [])-#endif- '*' -> if isNothing mdepth- then return (Node (TW as_t) [])- else return (Node (TN as_t_n) [])-#if ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_SINGLE_DIGIT__CAN_ONLY_EXPRESS_DOWN_TO_DEPTH_9- _ -> fail $ "compilePat: expected '*' or digit (got " ++ show b ++ ")"-#elif ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_NUMBER_ALONE__SAFE_ONLY_TO_DEPTH_19- _ -> fail $ "compilePat: expected '.' or '*' or digit (got " ++ show b ++ ")"-#else- _ -> fail $ "compilePat: expected '.' or '*' (got " ++ show b ++ ")"-#endif- where- as_t_n = as_t { depth = fromJust mdepth }----------------------------------------------------------------------------------- parsePat_WRTR_tail :: Bool -> Char -> PatNodeAttrs -> AT.Parser Pattern- parsePat_WRTR_tail isTR x as- = do- !_ <- mytrace "parsePat_WRTR_tail." $ return ()--- AT.takeText >>= \ roi -> error $ "DEVEXIT: " ++ show roi- pats <- parsePats <|> pure []-#if USE_CURLY_BRACE_INSTEAD_OF_PAREN_FOR_SUBPATTERNS- AT.char '}'-#else- AT.char ')'-#endif- if isTR- then return (Node (TR as) pats)- else return (Node (WR as) pats)----------------------------------------------------------------------------------- parse_type_constraints :: AT.Parser [T.Text]- parse_type_constraints = do- !_ <- mytrace "parse_type_constraints." $ return ()- let endchar = ':'- let sepchar = ';'- let loop = do- seg <- AT.takeWhile (\c->c/=endchar&&c/='\\') :: AT.Parser T.Text- if T.null seg- then do- return []- else do- (do- AT.char '\\' *> AT.anyChar- >>= \ c -> ( ( seg `T.snoc` '\\' `T.snoc` c ) : ) <$> loop- )- <|> (do- AT.char endchar- return [seg]- )- <|> (fail "parse_type_constraints: unexpected end of input")- segs <- loop- let seg = T.concat segs- let eblocks = AT.parseOnly- ( AT.sepBy1'- (AT.takeWhile (/=sepchar))- (AT.char sepchar)- )- seg- let blocks = case eblocks of- Left msg -> fail $ "parse_type_constraints: eblocks parse failure: " ++ msg- Right blocks -> map T.strip blocks- return blocks- {-# INLINE parse_type_constraints #-}----------------------------------------------------------------------------------- -- Try attoparsec.---- XXX If you toggle this, don't forget to also toggle--- the one in Compile_shared_utils2.hs (compilePat_).-#if 1-- compileUsingAttoparsec :: T.Text -> AT.Result [Pattern]- compileUsingAttoparsec input- = AT.feed (AT.parse parsePatsTop input) T.empty--#else-- compileUsingAttoparsec :: T.Text -> Either String [Pattern]- compileUsingAttoparsec input- = AT.parseOnly parsePatsTop input--#endif-----------------------------------------------------------------------------------#else--#if 1-- -- This was such a pleasure to write after the attoparsec- -- learning curve above!!... I wonder if the atto parser- -- could ever be made to be as concise as this?+ -- XXX This is still lacks support for the two condensed grammars:+ -- ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_NUMBER_ALONE__SAFE_ONLY_TO_DEPTH_19+ -- ABBREV_WN_AND_TN_CONCRETE_SYNTAX_TO_SINGLE_DIGIT__CAN_ONLY_EXPRESS_DOWN_TO_DEPTH_9 compilePat' :: String -> Pattern compilePat' s@@ -517,14 +90,10 @@ (Right pat, s') -> compilePats s' (pat:acc) where s_ltrim = dropWhile isSpace s -#if 0- -- nice one from http://stackoverflow.com/a/6270337- trim :: String -> String- trim = let f = reverse . dropWhile isSpace in f . f-#endif- -- XXX Don't forget to do a post-pass to change W* nodes -- to corresponding T* nodes, when : modifier was present!+-- Oops, guess I did it here; but the original idea would+-- be less cloning... cpat :: String -> (Either String Pattern, String) --cpat _ | trace "J-1: " $ False = undefined@@ -674,21 +243,6 @@ , pseqPerm = Just $ map (\c -> ord c - ord 'a') perm } (perm, s') = span isLower s ok = sort perm == take (length perm) ['a'..'z']-#endif--#else- err = intercalate "\n"- [ "\n"- , "Sorry, at this time (version 0.6.0.*) there is no non-attoparsec parser"- , "for the new pattern grammar. This also implies that HASKELL98_FRAGMENT"- , "has no pattern DSL facilities (except for showPat), and it is necessary"- , "to work with the PatNode constructors directly. The situation should"- , "be remedied by version 0.6.1."- ]- compilePat' :: String -> Pattern- compilePat' _ = error err-#endif- #endif -------------------------------------------------------------------------------
@@ -27,10 +27,6 @@ ------------------------------------------------------------------------------- -#if USE_ATTOPARSEC- {-# LANGUAGE OverloadedStrings #-}-#endif- #if DO_DERIVE_DATA_AND_TYPEABLE {-# LANGUAGE DeriveDataTypeable #-} #endif@@ -113,16 +109,7 @@ -- Temporary until commit to new grammar exclusively (or decide to -- really continue supporting both)... #if NEW_IMPROVED_PATTERN_GRAMMAR-#if USE_ATTOPARSEC- import qualified Data.Attoparsec.Text as AT ( IResult(..) )---import qualified Data.Attoparsec.ByteString as AB ( IResult(..) )---import Data.Attoparsec.ByteString.Lazy- import qualified Data.Text as T- import qualified Data.ByteString.Lazy as BL- import Control.DeepSeq.Bounded.Compile_new_grammar ( compileUsingAttoparsec )-#else import Control.DeepSeq.Bounded.Compile_new_grammar ( compilePat' )-#endif #else import Control.DeepSeq.Bounded.Compile_old_grammar ( compilePat' ) #endif@@ -153,86 +140,10 @@ #if NEW_IMPROVED_PATTERN_GRAMMAR -#if USE_ATTOPARSEC- compilePat_ :: String -> Pattern- compilePat_ str- | null plst = error "compilePat: syntax error"---- | null plst = error "compilePat: empty pattern (syntax error)"-#if 1- | length plst > 1 = setPatternPatNodeUniqueIDs 0 $ liftPats plst-#else- | length plst > 1 = error $ "compilePat: disconnected pattern (not rooted)"-#if USE_CURLY_BRACE_INSTEAD_OF_PAREN_FOR_SUBPATTERNS- ++ "\nPerhaps you used parentheses instead of braces?"-#else- ++ ""-#endif-#endif---- | not $ null s' = error $ "compilePat: parse error: not all input consumed\nRemaining: " ++ s'- | otherwise = setPatternPatNodeUniqueIDs 0 $ head plst---- | otherwise = head plst- where---- XXX If you toggle this, don't forget to also toggle the--- one in Compile_new_grammar.hs (compileUsingAttoparsec).-#if 1--#if 1-#if 0- plst = ff (compileUsingAttoparsec $ str)--- plst = ff (compileUsingAttoparsec $ BL.pack str)- ff :: AT.IResult BL.ByteString [Pattern] -> [Pattern]-#else- plst = ff (compileUsingAttoparsec $ T.pack str)- ff :: AT.IResult T.Text [Pattern] -> [Pattern]-#endif- ff rslt = plst- where- plst = case rslt of- AT.Fail leftovers ctxs msg- -> error $ "compilePat: " ++ msg ++ "\nInput remaining: " ++ T.unpack leftovers- AT.Partial f_leftovers- -> ff $ f_leftovers ""---- -> error $ "compilePat: parser demands more input"---- -> error_leftovers leftovers r- AT.Done leftovers r- -> if T.null leftovers then r- else error_leftovers leftovers r-#else- rslt = compileUsingAttoparsec str- plst = case rslt of- Fail leftovers ctxs msg- -> error $ "compilePat: " ++ msg ++ "\nInput remaining: " ++ T.unpack leftovers- Partial f_leftovers- -> f_leftovers ""---- -> error $ "compilePat: parser demands more input"---- -> error_leftovers leftovers r- Done leftovers r- -> if T.null leftovers then r- else error_leftovers leftovers r-#endif- error_leftovers s r = error $ "compilePat: input not completely consumed\nInput remaining: " ++ T.unpack s ++ "\nPatterns so far parsed: " ++ show r--#else-- esp = compileUsingAttoparsec $ T.pack str- plst = case esp of- Left s -> error $ "compilePat: parse error: " ++ s- Right plst -> plst--#endif--#else--- else ! USE_ATTOPARSEC-- compilePat_ :: String -> Pattern compilePat_ str = compilePat' str -#endif- #else--- else ! NEW_IMPROVED_PATTERN_GRAMMAR compilePat_ :: String -> Pattern --compilePat_ :: String -> (Pattern, String)