diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,56 +1,39 @@ -.PHONY : all clean configure dist dist-test docs docs-open lint \ - maintainer-clean test - -all : configure +.PHONY : all +all : cabal build -test : all +.PHONY : test +test : cabal test ################################ # department of sanitation ################################ +.PHONY : clean clean : cabal clean # remove emacs cruft -find . -name '*~' -delete -find . -name '\#*' -delete -maintainer-clean : clean - -cabal sandbox delete - -rm cabal.config - ################################ -# the cabal does not exist -################################ - -cabal.config : - echo 'tests: True' > cabal.config - -.cabal-sandbox : - cabal sandbox init - -configure : .cabal-sandbox cabal.config - cabal install --dependencies-only - cabal configure - -################################ # distribution ################################ +.PHONY : dist dist : all -cabal check cabal sdist TEMPDIR := $(shell mktemp -d /tmp/temp.XXXX) +.PHONY : dist-test dist-test : dist $(eval DIR := $(shell (cabal info . | awk '{print $$2 ; exit}'))) $(eval TARBALL := $(DIR).tar) $(eval TGZBALL := $(TARBALL).gz) - echo $(TEMPDIR) - cp dist/$(TGZBALL) $(TEMPDIR) + cp dist-newstyle/sdist/$(TGZBALL) $(TEMPDIR) cd $(TEMPDIR) && gunzip $(TGZBALL) && tar -xf $(TARBALL) cd $(TEMPDIR)/$(DIR) && make test rm -rf $(TEMPDIR) @@ -59,16 +42,28 @@ # documentation ################################ -docs : configure - cabal haddock +.PHONY : docs +docs : + cabal haddock --haddock-for-hackage +.PHONY : docs-open docs-open : docs - open dist/doc/html/context-free-grammar/index.html + # I can't find a better way to find the haddocks than guessing. + open `find dist-newstyle/ -name doc-index.html` + ################################ +# reformatting +################################ + +.PHONY : reformat +reformat : + find src tests -name '*.hs' -exec hindent \{} \; + +################################ # de-linting ################################ +.PHONY : lint lint : - hlint -i 'Use import/export shortcut' src tests - # The import/export shortcut plays poorly with Haddock + hlint src tests diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +0.1.1 (2021-05-28): + - Backport of contributions from Andreas Abel to update for modern + GHC. Removed tabs, reformatted with hindent, updated Makefile + for modern cabal, added github workflow. Delinted. 0.1.0 (2015-04-02): - Restructured API so default is to keep partial analysis results; old way was too error-prone. diff --git a/context-free-grammar.cabal b/context-free-grammar.cabal --- a/context-free-grammar.cabal +++ b/context-free-grammar.cabal @@ -1,10 +1,10 @@ Name: context-free-grammar -Version: 0.1.0 +Version: 0.1.1 Author: Eric Nedervold Maintainer: Eric Nedervold License: BSD3 License-File: LICENSE -Copyright: (c) 2015 Eric Nedervold +Copyright: (c) 2015, 2021 Eric Nedervold, 2021 Andreas Abel. Stability: alpha Homepage: http://github.com/nedervold/context-free-grammar Bug-Reports: http://github.com/nedervold/context-free-grammar/issues @@ -40,6 +40,17 @@ Build-Type: Simple Extra-Source-Files: Makefile , changelog +Tested-With: + GHC == 7.8.4 + GHC == 7.10.3 + GHC == 8.0.2 + GHC == 8.2.2 + GHC == 8.4.4 + GHC == 8.6.5 + GHC == 8.8.4 + GHC == 8.10.4 + GHC == 9.0.1 + Library Default-Language: Haskell2010 HS-Source-Dirs: src @@ -73,8 +84,12 @@ , dlist >= 0.7 , mtl >= 2.1 , pretty >= 1.1 + , semigroups , template-haskell + Build-Tools: alex + , happy + Test-Suite test Type: exitcode-stdio-1.0 Default-Language: Haskell2010 @@ -104,4 +119,3 @@ Source-Repository head Type: git Location: git://github.com/nedervold/context-free-grammar.git - diff --git a/dist/build/Data/Cfg/Bnf/Parser.hs b/dist/build/Data/Cfg/Bnf/Parser.hs deleted file mode 100644 --- a/dist/build/Data/Cfg/Bnf/Parser.hs +++ /dev/null @@ -1,539 +0,0 @@ -{-# OPTIONS_GHC -w #-} -{-# OPTIONS -fglasgow-exts -cpp #-} --- | Parser for Bnf -module Data.Cfg.Bnf.Parser(parse) where - -import qualified Data.Map as M -import Data.Cfg.Bnf.Scanner(scan) -import Data.Cfg.Bnf.Syntax -import Data.Cfg.Bnf.Token -import Data.Cfg.Cfg(Production, V(..), Vs) -import qualified Data.Array as Happy_Data_Array -import qualified GHC.Exts as Happy_GHC_Exts -import Control.Applicative(Applicative(..)) - --- parser produced by Happy Version 1.19.4 - -newtype HappyAbsSyn = HappyAbsSyn HappyAny -#if __GLASGOW_HASKELL__ >= 607 -type HappyAny = Happy_GHC_Exts.Any -#else -type HappyAny = forall a . a -#endif -happyIn4 :: (Grammar String String) -> (HappyAbsSyn ) -happyIn4 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn4 #-} -happyOut4 :: (HappyAbsSyn ) -> (Grammar String String) -happyOut4 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut4 #-} -happyIn5 :: ([Production String String]) -> (HappyAbsSyn ) -happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn5 #-} -happyOut5 :: (HappyAbsSyn ) -> ([Production String String]) -happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut5 #-} -happyIn6 :: ([Production String String]) -> (HappyAbsSyn ) -happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn6 #-} -happyOut6 :: (HappyAbsSyn ) -> ([Production String String]) -happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut6 #-} -happyIn7 :: ([Vs String String]) -> (HappyAbsSyn ) -happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn7 #-} -happyOut7 :: (HappyAbsSyn ) -> ([Vs String String]) -happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut7 #-} -happyIn8 :: ([Vs String String]) -> (HappyAbsSyn ) -happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn8 #-} -happyOut8 :: (HappyAbsSyn ) -> ([Vs String String]) -happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut8 #-} -happyIn9 :: (Vs String String) -> (HappyAbsSyn ) -happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn9 #-} -happyOut9 :: (HappyAbsSyn ) -> (Vs String String) -happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut9 #-} -happyIn10 :: (Vs String String) -> (HappyAbsSyn ) -happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn10 #-} -happyOut10 :: (HappyAbsSyn ) -> (Vs String String) -happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut10 #-} -happyIn11 :: (V String String) -> (HappyAbsSyn ) -happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyIn11 #-} -happyOut11 :: (HappyAbsSyn ) -> (V String String) -happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut11 #-} -happyInTok :: (Token) -> (HappyAbsSyn ) -happyInTok x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyInTok #-} -happyOutTok :: (HappyAbsSyn ) -> (Token) -happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOutTok #-} - - -happyActOffsets :: HappyAddr -happyActOffsets = HappyA# "\x11\x00\x11\x00\x11\x00\x00\x00\x10\x00\x0c\x00\x00\x00\x00\x00\x0f\x00\x0e\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -happyGotoOffsets :: HappyAddr -happyGotoOffsets = HappyA# "\x05\x00\x0d\x00\x09\x00\x00\x00\x00\x00\x00\x00\xfe\xff\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00"# - -happyDefActions :: HappyAddr -happyDefActions = HappyA# "\x00\x00\x00\x00\xfe\xff\xfc\xff\x00\x00\x00\x00\xf5\xff\xfd\xff\x00\x00\xfa\xff\xf8\xff\xf7\xff\xf6\xff\xf3\xff\xf4\xff\xf5\xff\xfb\xff\xf9\xff"# - -happyCheck :: HappyAddr -happyCheck = HappyA# "\xff\xff\x03\x00\x04\x00\x05\x00\x06\x00\x00\x00\x01\x00\x02\x00\x02\x00\x07\x00\x04\x00\x02\x00\x05\x00\x06\x00\x01\x00\x02\x00\x01\x00\x03\x00\x06\x00\x02\x00\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff"# - -happyTable :: HappyAddr -happyTable = HappyA# "\x00\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x05\x00\x02\x00\x03\x00\x0e\x00\x0c\x00\x0f\x00\x07\x00\x11\x00\x0b\x00\x02\x00\x03\x00\x11\x00\x10\x00\xff\xff\x05\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -happyReduceArr = Happy_Data_Array.array (1, 12) [ - (1 , happyReduce_1), - (2 , happyReduce_2), - (3 , happyReduce_3), - (4 , happyReduce_4), - (5 , happyReduce_5), - (6 , happyReduce_6), - (7 , happyReduce_7), - (8 , happyReduce_8), - (9 , happyReduce_9), - (10 , happyReduce_10), - (11 , happyReduce_11), - (12 , happyReduce_12) - ] - -happy_n_terms = 7 :: Int -happy_n_nonterms = 8 :: Int - -happyReduce_1 = happySpecReduce_1 0# happyReduction_1 -happyReduction_1 happy_x_1 - = case happyOut5 happy_x_1 of { happy_var_1 -> - happyIn4 - (Grammar happy_var_1 - )} - -happyReduce_2 = happySpecReduce_2 1# happyReduction_2 -happyReduction_2 happy_x_2 - happy_x_1 - = case happyOut5 happy_x_1 of { happy_var_1 -> - case happyOut6 happy_x_2 of { happy_var_2 -> - happyIn5 - (happy_var_1 ++ happy_var_2 - )}} - -happyReduce_3 = happySpecReduce_1 1# happyReduction_3 -happyReduction_3 happy_x_1 - = case happyOut6 happy_x_1 of { happy_var_1 -> - happyIn5 - (happy_var_1 - )} - -happyReduce_4 = happyReduce 4# 2# happyReduction_4 -happyReduction_4 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { (Token LOWER_IDENTIFIER happy_var_1) -> - case happyOut7 happy_x_3 of { happy_var_3 -> - happyIn6 - ([ (happy_var_1, alt) | alt <- happy_var_3 ] - ) `HappyStk` happyRest}} - -happyReduce_5 = happySpecReduce_1 3# happyReduction_5 -happyReduction_5 happy_x_1 - = case happyOut8 happy_x_1 of { happy_var_1 -> - happyIn7 - (happy_var_1 - )} - -happyReduce_6 = happySpecReduce_3 4# happyReduction_6 -happyReduction_6 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut9 happy_x_3 of { happy_var_3 -> - happyIn8 - (happy_var_1 ++ [ happy_var_3 ] - )}} - -happyReduce_7 = happySpecReduce_1 4# happyReduction_7 -happyReduction_7 happy_x_1 - = case happyOut9 happy_x_1 of { happy_var_1 -> - happyIn8 - ([ happy_var_1 ] - )} - -happyReduce_8 = happySpecReduce_1 5# happyReduction_8 -happyReduction_8 happy_x_1 - = case happyOut10 happy_x_1 of { happy_var_1 -> - happyIn9 - (happy_var_1 - )} - -happyReduce_9 = happySpecReduce_2 6# happyReduction_9 -happyReduction_9 happy_x_2 - happy_x_1 - = case happyOut10 happy_x_1 of { happy_var_1 -> - case happyOut11 happy_x_2 of { happy_var_2 -> - happyIn10 - (happy_var_1 ++ [ happy_var_2 ] - )}} - -happyReduce_10 = happySpecReduce_0 6# happyReduction_10 -happyReduction_10 = happyIn10 - ([] - ) - -happyReduce_11 = happySpecReduce_1 7# happyReduction_11 -happyReduction_11 happy_x_1 - = case happyOutTok happy_x_1 of { (Token UPPER_IDENTIFIER happy_var_1) -> - happyIn11 - (T happy_var_1 - )} - -happyReduce_12 = happySpecReduce_1 7# happyReduction_12 -happyReduction_12 happy_x_1 - = case happyOutTok happy_x_1 of { (Token LOWER_IDENTIFIER happy_var_1) -> - happyIn11 - (NT happy_var_1 - )} - -happyNewToken action sts stk [] = - happyDoAction 6# notHappyAtAll action sts stk [] - -happyNewToken action sts stk (tk:tks) = - let cont i = happyDoAction i tk action sts stk tks in - case tk of { - Token FULL_STOP happy_dollar_dollar -> cont 1#; - Token LOWER_IDENTIFIER happy_dollar_dollar -> cont 2#; - Token OR happy_dollar_dollar -> cont 3#; - Token UPPER_IDENTIFIER happy_dollar_dollar -> cont 4#; - Token YIELDS happy_dollar_dollar -> cont 5#; - _ -> happyError' (tk:tks) - } - -happyError_ 6# tk tks = happyError' tks -happyError_ _ tk tks = happyError' (tk:tks) - -newtype HappyIdentity a = HappyIdentity a -happyIdentity = HappyIdentity -happyRunIdentity (HappyIdentity a) = a - -instance Functor HappyIdentity where - fmap f (HappyIdentity a) = HappyIdentity (f a) - -instance Applicative HappyIdentity where - pure = return - a <*> b = (fmap id a) <*> b -instance Monad HappyIdentity where - return = HappyIdentity - (HappyIdentity p) >>= q = q p - -happyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b -happyThen = (>>=) -happyReturn :: () => a -> HappyIdentity a -happyReturn = (return) -happyThen1 m k tks = (>>=) m (\a -> k a tks) -happyReturn1 :: () => a -> b -> HappyIdentity a -happyReturn1 = \a tks -> (return) a -happyError' :: () => [(Token)] -> HappyIdentity a -happyError' = HappyIdentity . parseError - -parseTokens tks = happyRunIdentity happySomeParser where - happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x)) - -happySeq = happyDontSeq - - -parseError :: [Token] -> a -parseError ts = error $ "parseError at: " ++ show ts - --- | Parses Bnf source into a 'Grammar'. -parse :: String -> Grammar String String -parse = parseTokens . scan - --- | Parses a list of 'Token's into a 'Grammar'. -parseTokens :: [Token] -> Grammar String String -{-# LINE 1 "templates/GenericTemplate.hs" #-} --- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp - - - - - - - --- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. -#if __GLASGOW_HASKELL__ > 706 -#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool) -#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool) -#define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Bool) -#else -#define LT(n,m) (n Happy_GHC_Exts.<# m) -#define GTE(n,m) (n Happy_GHC_Exts.>=# m) -#define EQ(n,m) (n Happy_GHC_Exts.==# m) -#endif - - - -data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList - - - - - - - - - - - - - - - - - - -infixr 9 `HappyStk` -data HappyStk a = HappyStk a (HappyStk a) - ------------------------------------------------------------------------------ --- starting the parse - -happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll - ------------------------------------------------------------------------------ --- Accepting the parse - --- If the current token is 0#, it means we've just accepted a partial --- parse (a %partial parser). We must ignore the saved token on the top of --- the stack in this case. -happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = - happyReturn1 ans -happyAccept j tk st sts (HappyStk ans _) = - (happyTcHack j (happyTcHack st)) (happyReturn1 ans) - ------------------------------------------------------------------------------ --- Arrays only: do the next action - - - -happyDoAction i tk st - = {- nothing -} - - - case action of - 0# -> {- nothing -} - happyFail i tk st - -1# -> {- nothing -} - happyAccept i tk st - n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -} - - (happyReduceArr Happy_Data_Array.! rule) i tk st - where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#)))))) - n -> {- nothing -} - - - happyShift new_state i tk st - where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) - where off = indexShortOffAddr happyActOffsets st - off_i = (off Happy_GHC_Exts.+# i) - check = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#)) - then EQ(indexShortOffAddr happyCheck off_i, i) - else False - action - | check = indexShortOffAddr happyTable off_i - | otherwise = indexShortOffAddr happyDefActions st - - -indexShortOffAddr (HappyA# arr) off = - Happy_GHC_Exts.narrow16Int# i - where - i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low) - high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#))) - low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off')) - off' = off Happy_GHC_Exts.*# 2# - - - - - -data HappyAddr = HappyA# Happy_GHC_Exts.Addr# - - - - ------------------------------------------------------------------------------ --- HappyState data type (not arrays) - - - ------------------------------------------------------------------------------ --- Shifting a token - -happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = - let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in --- trace "shifting the error token" $ - happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) - -happyShift new_state i tk st sts stk = - happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) - --- happyReduce is specialised for the common cases. - -happySpecReduce_0 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_0 nt fn j tk st@((action)) sts stk - = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) - -happySpecReduce_1 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') - = let r = fn v1 in - happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) - -happySpecReduce_2 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') - = let r = fn v1 v2 in - happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) - -happySpecReduce_3 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') - = let r = fn v1 v2 v3 in - happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) - -happyReduce k i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyReduce k nt fn j tk st sts stk - = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of - sts1@((HappyCons (st1@(action)) (_))) -> - let r = fn stk in -- it doesn't hurt to always seq here... - happyDoSeq r (happyGoto nt j tk st1 sts1 r) - -happyMonadReduce k nt fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyMonadReduce k nt fn j tk st sts stk = - case happyDrop k (HappyCons (st) (sts)) of - sts1@((HappyCons (st1@(action)) (_))) -> - let drop_stk = happyDropStk k stk in - happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) - -happyMonad2Reduce k nt fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyMonad2Reduce k nt fn j tk st sts stk = - case happyDrop k (HappyCons (st) (sts)) of - sts1@((HappyCons (st1@(action)) (_))) -> - let drop_stk = happyDropStk k stk - - off = indexShortOffAddr happyGotoOffsets st1 - off_i = (off Happy_GHC_Exts.+# nt) - new_state = indexShortOffAddr happyTable off_i - - - - in - happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) - -happyDrop 0# l = l -happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t - -happyDropStk 0# l = l -happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs - ------------------------------------------------------------------------------ --- Moving to a new state after a reduction - - -happyGoto nt j tk st = - {- nothing -} - happyDoAction j tk new_state - where off = indexShortOffAddr happyGotoOffsets st - off_i = (off Happy_GHC_Exts.+# nt) - new_state = indexShortOffAddr happyTable off_i - - - - ------------------------------------------------------------------------------ --- Error recovery (0# is the error token) - --- parse error if we are in recovery and we fail again -happyFail 0# tk old_st _ stk@(x `HappyStk` _) = - let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in --- trace "failing" $ - happyError_ i tk - -{- We don't need state discarding for our restricted implementation of - "error". In fact, it can cause some bogus parses, so I've disabled it - for now --SDM - --- discard a state -happyFail 0# tk old_st (HappyCons ((action)) (sts)) - (saved_tok `HappyStk` _ `HappyStk` stk) = --- trace ("discarding state, depth " ++ show (length stk)) $ - happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) --} - --- Enter error recovery: generate an error token, --- save the old token and carry on. -happyFail i tk (action) sts stk = --- trace "entering error recovery" $ - happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) - --- Internal happy errors: - -notHappyAtAll :: a -notHappyAtAll = error "Internal Happy error\n" - ------------------------------------------------------------------------------ --- Hack to get the typechecker to accept our action functions - - -happyTcHack :: Happy_GHC_Exts.Int# -> a -> a -happyTcHack x y = y -{-# INLINE happyTcHack #-} - - ------------------------------------------------------------------------------ --- Seq-ing. If the --strict flag is given, then Happy emits --- happySeq = happyDoSeq --- otherwise it emits --- happySeq = happyDontSeq - -happyDoSeq, happyDontSeq :: a -> b -> b -happyDoSeq a b = a `seq` b -happyDontSeq a b = b - ------------------------------------------------------------------------------ --- Don't inline any functions from the template. GHC has a nasty habit --- of deciding to inline happyGoto everywhere, which increases the size of --- the generated parser quite a bit. - - -{-# NOINLINE happyDoAction #-} -{-# NOINLINE happyTable #-} -{-# NOINLINE happyCheck #-} -{-# NOINLINE happyActOffsets #-} -{-# NOINLINE happyGotoOffsets #-} -{-# NOINLINE happyDefActions #-} - -{-# NOINLINE happyShift #-} -{-# NOINLINE happySpecReduce_0 #-} -{-# NOINLINE happySpecReduce_1 #-} -{-# NOINLINE happySpecReduce_2 #-} -{-# NOINLINE happySpecReduce_3 #-} -{-# NOINLINE happyReduce #-} -{-# NOINLINE happyMonadReduce #-} -{-# NOINLINE happyGoto #-} -{-# NOINLINE happyFail #-} - --- end of Happy Template. - diff --git a/dist/build/Data/Cfg/Bnf/Scanner.hs b/dist/build/Data/Cfg/Bnf/Scanner.hs deleted file mode 100644 --- a/dist/build/Data/Cfg/Bnf/Scanner.hs +++ /dev/null @@ -1,360 +0,0 @@ -{-# LANGUAGE CPP,MagicHash #-} -{-# LINE 1 "src/Data/Cfg/Bnf/Scanner.x" #-} - -{-# OPTIONS_GHC -w #-} --- | Scanner for Bnf -module Data.Cfg.Bnf.Scanner(scan) where - -import Data.Cfg.Bnf.Token - -#if __GLASGOW_HASKELL__ >= 603 -#include "ghcconfig.h" -#elif defined(__GLASGOW_HASKELL__) -#include "config.h" -#endif -#if __GLASGOW_HASKELL__ >= 503 -import Data.Array -import Data.Char (ord) -import Data.Array.Base (unsafeAt) -#else -import Array -import Char (ord) -#endif -#if __GLASGOW_HASKELL__ >= 503 -import GHC.Exts -#else -import GlaExts -#endif -{-# LINE 1 "templates/wrappers.hs" #-} --- ----------------------------------------------------------------------------- --- Alex wrapper code. --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - -import Data.Word (Word8) - - -import qualified Data.Bits - --- | Encode a Haskell String to a list of Word8 values, in UTF8 format. -utf8Encode :: Char -> [Word8] -utf8Encode = map fromIntegral . go . ord - where - go oc - | oc <= 0x7f = [oc] - - | oc <= 0x7ff = [ 0xc0 + (oc `Data.Bits.shiftR` 6) - , 0x80 + oc Data.Bits..&. 0x3f - ] - - | oc <= 0xffff = [ 0xe0 + (oc `Data.Bits.shiftR` 12) - , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f) - , 0x80 + oc Data.Bits..&. 0x3f - ] - | otherwise = [ 0xf0 + (oc `Data.Bits.shiftR` 18) - , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f) - , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f) - , 0x80 + oc Data.Bits..&. 0x3f - ] - - - -type Byte = Word8 - --- ----------------------------------------------------------------------------- --- The input type - - - - - - - - - --- ----------------------------------------------------------------------------- --- Token positions - --- `Posn' records the location of a token in the input text. It has three --- fields: the address (number of chacaters preceding the token), line number --- and column of a token within the file. `start_pos' gives the position of the --- start of the file and `eof_pos' a standard encoding for the end of file. --- `move_pos' calculates the new position after traversing a given character, --- assuming the usual eight character tab stops. - - - --- ----------------------------------------------------------------------------- --- Default monad - - - - --- ----------------------------------------------------------------------------- --- Monad (with ByteString input) - - - - --- ----------------------------------------------------------------------------- --- Basic wrapper - - -type AlexInput = (Char,[Byte],String) - -alexInputPrevChar :: AlexInput -> Char -alexInputPrevChar (c,_,_) = c - --- alexScanTokens :: String -> [token] -alexScanTokens str = go ('\n',[],str) - where go inp@(_,_bs,s) = - case alexScan inp 0 of - AlexEOF -> [] - AlexError _ -> error "lexical error" - AlexSkip inp' len -> go inp' - AlexToken inp' len act -> act (take len s) : go inp' - -alexGetByte :: AlexInput -> Maybe (Byte,AlexInput) -alexGetByte (c,(b:bs),s) = Just (b,(c,bs,s)) -alexGetByte (c,[],[]) = Nothing -alexGetByte (_,[],(c:s)) = case utf8Encode c of - (b:bs) -> Just (b, (c, bs, s)) - [] -> Nothing - - - --- ----------------------------------------------------------------------------- --- Basic wrapper, ByteString version - - - - - - --- ----------------------------------------------------------------------------- --- Posn wrapper - --- Adds text positions to the basic model. - - - - --- ----------------------------------------------------------------------------- --- Posn wrapper, ByteString version - - - - --- ----------------------------------------------------------------------------- --- GScan wrapper - --- For compatibility with previous versions of Alex, and because we can. - - -alex_base :: AlexAddr -alex_base = AlexA# "\x01\x00\x00\x00\x44\x00\x00\x00\x76\x00\x00\x00\xf6\x00\x00\x00\x76\x01\x00\x00\xe7\x01\x00\x00\x00\x00\x00\x00\x67\x02\x00\x00\x00\x00\x00\x00\xd8\x02\x00\x00\x00\x00\x00\x00\xc3\xff\xff\xff\x00\x00\x00\x00\x19\x03\x00\x00\x19\x04\x00\x00\xd9\x03\x00\x00\x00\x00\x00\x00\xd9\x04\x00\x00\x99\x04\x00\x00\x00\x00\x00\x00\x90\x05\x00\x00\x94\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x05\x00\x00\x64\x06\x00\x00\x7c\x05\x00\x00\x00\x00\x00\x00\x70\x05\x00\x00"# - -alex_table :: AlexAddr -alex_table = AlexA# "\x00\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x14\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1b\x00\x18\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1d\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x1c\x00\x17\x00\x1c\x00\x1c\x00\x1c\x00\x16\x00\x0f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x0f\x00\x03\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0b\x00\x07\x00\x06\x00\x06\x00\x06\x00\x05\x00\x11\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x0e\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x02\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\xff\xff\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x15\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x12\x00\x02\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0d\x00\x04\x00\x08\x00\x08\x00\x08\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -alex_check :: AlexAddr -alex_check = AlexA# "\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x3d\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2d\x00\x3a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_deflt :: AlexAddr -alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0a\x00\xff\xff\x0c\x00\x0c\x00\x10\x00\x10\x00\x13\x00\x13\x00\x1c\x00\x1c\x00\x1c\x00\x15\x00\x15\x00\x15\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_accept = listArray (0::Int,29) [AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccSkip,AlexAccSkip,AlexAcc (alex_action_2),AlexAcc (alex_action_3),AlexAcc (alex_action_4),AlexAcc (alex_action_5),AlexAcc (alex_action_6),AlexAcc (alex_action_7),AlexAcc (alex_action_7),AlexAcc (alex_action_7)] -{-# LINE 26 "src/Data/Cfg/Bnf/Scanner.x" #-} - --- | Tokenizes a source string. -scan :: String -> [Token] -scan = alexScanTokens - -alex_action_2 = Token YIELDS -alex_action_3 = Token OR -alex_action_4 = Token FULL_STOP -alex_action_5 = Token LOWER_IDENTIFIER -alex_action_6 = Token UPPER_IDENTIFIER -alex_action_7 = Token ERROR -{-# LINE 1 "templates/GenericTemplate.hs" #-} --- ----------------------------------------------------------------------------- --- ALEX TEMPLATE --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - --- ----------------------------------------------------------------------------- --- INTERNALS and main scanner engine - - - - - - - --- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. -#if __GLASGOW_HASKELL__ > 706 -#define GTE(n,m) (tagToEnum# (n >=# m)) -#define EQ(n,m) (tagToEnum# (n ==# m)) -#else -#define GTE(n,m) (n >=# m) -#define EQ(n,m) (n ==# m) -#endif - - - -data AlexAddr = AlexA# Addr# --- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. -#if __GLASGOW_HASKELL__ < 503 -uncheckedShiftL# = shiftL# -#endif - -{-# INLINE alexIndexInt16OffAddr #-} -alexIndexInt16OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow16Int# i - where - i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) - high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - low = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 2# -#else - indexInt16OffAddr# arr off -#endif - - - - - -{-# INLINE alexIndexInt32OffAddr #-} -alexIndexInt32OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow32Int# i - where - i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` - (b2 `uncheckedShiftL#` 16#) `or#` - (b1 `uncheckedShiftL#` 8#) `or#` b0) - b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) - b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) - b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - b0 = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 4# -#else - indexInt32OffAddr# arr off -#endif - - - - - - -#if __GLASGOW_HASKELL__ < 503 -quickIndex arr i = arr ! i -#else --- GHC >= 503, unsafeAt is available from Data.Array.Base. -quickIndex = unsafeAt -#endif - - - - --- ----------------------------------------------------------------------------- --- Main lexing routines - -data AlexReturn a - = AlexEOF - | AlexError !AlexInput - | AlexSkip !AlexInput !Int - | AlexToken !AlexInput !Int a - --- alexScan :: AlexInput -> StartCode -> AlexReturn a -alexScan input (I# (sc)) - = alexScanUser undefined input (I# (sc)) - -alexScanUser user input (I# (sc)) - = case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, input') -> - case alexGetByte input of - Nothing -> - - - - AlexEOF - Just _ -> - - - - AlexError input' - - (AlexLastSkip input'' len, _) -> - - - - AlexSkip input'' len - - (AlexLastAcc k input''' len, _) -> - - - - AlexToken input''' len k - - --- Push the input through the DFA, remembering the most recent accepting --- state it encountered. - -alex_scan_tkn user orig_input len input s last_acc = - input `seq` -- strict in the input - let - new_acc = (check_accs (alex_accept `quickIndex` (I# (s)))) - in - new_acc `seq` - case alexGetByte input of - Nothing -> (new_acc, input) - Just (c, new_input) -> - - - - case fromIntegral c of { (I# (ord_c)) -> - let - base = alexIndexInt32OffAddr alex_base s - offset = (base +# ord_c) - check = alexIndexInt16OffAddr alex_check offset - - new_s = if GTE(offset,0#) && EQ(check,ord_c) - then alexIndexInt16OffAddr alex_table offset - else alexIndexInt16OffAddr alex_deflt s - in - case new_s of - -1# -> (new_acc, input) - -- on an error, we want to keep the input *before* the - -- character that failed, not after. - _ -> alex_scan_tkn user orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len) - -- note that the length is increased ONLY if this is the 1st byte in a char encoding) - new_input new_s new_acc - } - where - check_accs (AlexAccNone) = last_acc - check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) - - -data AlexLastAcc a - = AlexNone - | AlexLastAcc a !AlexInput !Int - | AlexLastSkip !AlexInput !Int - -instance Functor AlexLastAcc where - fmap f AlexNone = AlexNone - fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z - fmap f (AlexLastSkip x y) = AlexLastSkip x y - -data AlexAcc a user - = AlexAccNone - | AlexAcc a - | AlexAccSkip - - --- used by wrappers -iUnbox (I# (i)) = i - diff --git a/src/Data/Cfg.hs b/src/Data/Cfg.hs --- a/src/Data/Cfg.hs +++ b/src/Data/Cfg.hs @@ -1,20 +1,20 @@ -- | Context-free grammars. -module Data.Cfg( - module Data.Cfg.Analysis, - module Data.Cfg.Augment, - module Data.Cfg.Cfg, - module Data.Cfg.CPretty, - module Data.Cfg.FreeCfg, - module Data.Cfg.LookaheadSet, - module Data.Cfg.Productive, - module Data.Cfg.Reachable, - module Data.Cfg.RuleApplication - ) where +module Data.Cfg + ( module Data.Cfg.Analysis + , module Data.Cfg.Augment + , module Data.Cfg.Cfg + , module Data.Cfg.CPretty + , module Data.Cfg.FreeCfg + , module Data.Cfg.LookaheadSet + , module Data.Cfg.Productive + , module Data.Cfg.Reachable + , module Data.Cfg.RuleApplication + ) where import Data.Cfg.Analysis import Data.Cfg.Augment -import Data.Cfg.Cfg import Data.Cfg.CPretty +import Data.Cfg.Cfg import Data.Cfg.FreeCfg import Data.Cfg.LookaheadSet import Data.Cfg.Productive diff --git a/src/Data/Cfg/Analysis.hs b/src/Data/Cfg/Analysis.hs --- a/src/Data/Cfg/Analysis.hs +++ b/src/Data/Cfg/Analysis.hs @@ -1,12 +1,13 @@ -- | Analysis of a context-free grammar {-# LANGUAGE ScopedTypeVariables #-} -module Data.Cfg.Analysis ( - Analysis(..), - mkAnalysis, - Prediction, - Predictions - ) where +module Data.Cfg.Analysis + ( Analysis(..) + , mkAnalysis + , Prediction + , Predictions + ) where + import Data.Cfg.Augment import qualified Data.Cfg.Cfg as Cfg import Data.Cfg.FreeCfg @@ -14,51 +15,53 @@ import qualified Data.Cfg.Internal.FollowSet as I import qualified Data.Cfg.Internal.Nullable as I import qualified Data.Cfg.Internal.PredictSet as I -import Data.Cfg.Internal.PredictSet(Prediction, Predictions) +import Data.Cfg.Internal.PredictSet (Prediction, Predictions) import Data.Cfg.LookaheadSet import qualified Data.Map.Strict as M import qualified Data.Set as S -- | Analysis of a context-free grammar -data Analysis t nt = Analysis { - baseCfg :: FreeCfg t nt, - -- ^ (a 'FreeCfg' equivalent to) the source grammar - augmentedCfg :: FreeCfg (AugT t) (AugNT nt), - -- ^ the augmented grammar - nullables :: S.Set (AugNT nt), - -- ^ the nonterminals in the grammar that can produce the - -- empty string - firstSet :: AugNT nt -> LookaheadSet t, - -- ^ the first set of the nonterminal for the grammar - firstsOfVs :: AugVs t nt -> LookaheadSet t, - -- ^ the first set of a list of symbols - followSet :: AugNT nt -> LookaheadSet t, - -- ^ the follow set of the nonterminal for the grammar - predictSet :: AugProduction t nt -> LookaheadSet t, - -- ^ the predict set of the production - isLL1 :: Bool, - -- ^ 'True' iff the grammar is LL(1) - ll1Info :: AugNT nt -> Predictions t nt - -- ^ the productions for this nonterminal and the lookaheads - -- that predict them - } +data Analysis t nt = Analysis + { baseCfg :: FreeCfg t nt + -- ^ (a 'FreeCfg' equivalent to) the source grammar + , augmentedCfg :: FreeCfg (AugT t) (AugNT nt) + -- ^ the augmented grammar + , nullables :: S.Set (AugNT nt) + -- ^ the nonterminals in the grammar that can produce the + -- empty string + , firstSet :: AugNT nt -> LookaheadSet t + -- ^ the first set of the nonterminal for the grammar + , firstsOfVs :: AugVs t nt -> LookaheadSet t + -- ^ the first set of a list of symbols + , followSet :: AugNT nt -> LookaheadSet t + -- ^ the follow set of the nonterminal for the grammar + , predictSet :: AugProduction t nt -> LookaheadSet t + -- ^ the predict set of the production + , isLL1 :: Bool + -- ^ 'True' iff the grammar is LL(1) + , ll1Info :: AugNT nt -> Predictions t nt + -- ^ the productions for this nonterminal and the lookaheads + -- that predict them + } -- | Analyzes a context-free grammar -mkAnalysis :: forall cfg t nt - . (Cfg.Cfg cfg t nt, Ord nt, Ord t) - => cfg t nt -> Analysis t nt -mkAnalysis cfg = Analysis { - baseCfg = bcfg, - augmentedCfg = cfg', - nullables = ns, - firstSet = fs, - firstsOfVs = I.firstsOfVs fs, - followSet = fols, - predictSet = predict, - isLL1 = isLL1', - ll1Info = (ll1InfoMap M.!) +mkAnalysis :: + forall cfg t nt. (Cfg.Cfg cfg t nt, Ord nt, Ord t) + => cfg t nt + -> Analysis t nt +mkAnalysis cfg = + Analysis + { baseCfg = bcfg + , augmentedCfg = cfg' + , nullables = ns + , firstSet = fs + , firstsOfVs = I.firstsOfVs fs + , followSet = fols + , predictSet = predict + , isLL1 = isLL1' + , ll1Info = (ll1InfoMap M.!) } - where + where bcfg = toFreeCfg cfg cfg' = augmentCfg bcfg ns = I.nullables cfg' diff --git a/src/Data/Cfg/Augment.hs b/src/Data/Cfg/Augment.hs --- a/src/Data/Cfg/Augment.hs +++ b/src/Data/Cfg/Augment.hs @@ -1,29 +1,34 @@ -- | Augmented grammars. {-# LANGUAGE ScopedTypeVariables #-} -module Data.Cfg.Augment ( - -- * Augmenting grammars - augmentCfg, + +module Data.Cfg.Augment + ( -- * Augmenting grammars + augmentCfg -- * Augmenting symbols - AugNT(..), - AugT(..), + , AugNT(..) + , AugT(..) -- * Type synonyms - AugV, - AugVs, - AugProduction, - AugFreeCfg - ) where + , AugV + , AugVs + , AugProduction + , AugFreeCfg + ) where -import Data.Cfg.Cfg(Cfg(..), Production, V(..), Vs) -import Data.Cfg.FreeCfg(FreeCfg(..)) +import Data.Cfg.Cfg (Cfg(..), Production, V(..), Vs) +import Data.Cfg.FreeCfg (FreeCfg(..)) import qualified Data.Set as S -- | Nonterminal symbols augmented with a special 'StartSymbol' -data AugNT nt = StartSymbol | AugNT nt - deriving (Eq, Ord, Show) +data AugNT nt + = StartSymbol + | AugNT nt + deriving (Eq, Ord, Show) -- | Terminal symbols augmented with a special end-of-file symbol -data AugT t = EOF | AugT t - deriving (Eq, Ord, Show) +data AugT t + = EOF + | AugT t + deriving (Eq, Ord, Show) -- | A convenience synonym for an augmented vocabulary symbol type AugV t nt = V (AugT t) (AugNT nt) @@ -39,26 +44,26 @@ -- | Returns the /augmented/ grammar: a grammar for the same language -- but using explicit start and end-of-file symbols. -augmentCfg :: forall cfg t nt . (Cfg cfg t nt, Ord nt, Ord t) - => cfg t nt -> FreeCfg (AugT t) (AugNT nt) -augmentCfg cfg = FreeCfg { - nonterminals' = S.insert StartSymbol $ S.map AugNT $ nonterminals cfg, - terminals' = S.insert EOF $ S.map AugT $ terminals cfg, - productionRules' = pr, - startSymbol' = StartSymbol +augmentCfg :: + forall cfg t nt. (Cfg cfg t nt, Ord nt, Ord t) + => cfg t nt + -> FreeCfg (AugT t) (AugNT nt) +augmentCfg cfg = + FreeCfg + { nonterminals' = S.insert StartSymbol $ S.map AugNT $ nonterminals cfg + , terminals' = S.insert EOF $ S.map AugT $ terminals cfg + , productionRules' = pr + , startSymbol' = StartSymbol } - - where + where pr :: AugNT nt -> S.Set (Vs (AugT t) (AugNT nt)) pr StartSymbol = S.singleton [NT $ AugNT $ startSymbol cfg, T EOF] pr (AugNT nt) = S.map augmentVs oldRhss - where - oldRhss :: S.Set (Vs t nt) - oldRhss = productionRules cfg nt - - augmentVs :: Vs t nt -> Vs (AugT t) (AugNT nt) - augmentVs = map augmentV - - augmentV :: V t nt -> V (AugT t) (AugNT nt) - augmentV (NT nt') = NT $ AugNT nt' - augmentV (T t') = T $ AugT t' + where + oldRhss :: S.Set (Vs t nt) + oldRhss = productionRules cfg nt + augmentVs :: Vs t nt -> Vs (AugT t) (AugNT nt) + augmentVs = map augmentV + augmentV :: V t nt -> V (AugT t) (AugNT nt) + augmentV (NT nt') = NT $ AugNT nt' + augmentV (T t') = T $ AugT t' diff --git a/src/Data/Cfg/Bnf.hs b/src/Data/Cfg/Bnf.hs --- a/src/Data/Cfg/Bnf.hs +++ b/src/Data/Cfg/Bnf.hs @@ -16,14 +16,12 @@ characters and underscores. Quoted strings are literal tokens. -} - -module Data.Cfg.Bnf ( - Grammar(..), - bnf, - parse - ) where +module Data.Cfg.Bnf + ( Grammar(..) + , bnf + , parse + ) where import Data.Cfg.Bnf.Parser import Data.Cfg.Bnf.QQ import Data.Cfg.Bnf.Syntax - diff --git a/src/Data/Cfg/Bnf/QQ.hs b/src/Data/Cfg/Bnf/QQ.hs --- a/src/Data/Cfg/Bnf/QQ.hs +++ b/src/Data/Cfg/Bnf/QQ.hs @@ -1,5 +1,7 @@ -- | 'QuasiQuoter' for BNF source. -module Data.Cfg.Bnf.QQ(bnf) where +module Data.Cfg.Bnf.QQ + ( bnf + ) where import Data.Cfg.Bnf.Parser import Language.Haskell.TH.Quote @@ -7,11 +9,12 @@ -- | 'QuasiQuoter' for BNF source. Generates a value of type -- 'Grammar'. Not usable in pattern, type or declaration positions. bnf :: QuasiQuoter -bnf = QuasiQuoter { - quoteExp = dataToExpQ (const Nothing) . parse, - quotePat = err, - quoteType = err, - quoteDec = err +bnf = + QuasiQuoter + { quoteExp = dataToExpQ (const Nothing) . parse + , quotePat = err + , quoteType = err + , quoteDec = err } - where + where err _ = error "The bnf quasiquoter is only allowed in Exp position." diff --git a/src/Data/Cfg/Bnf/Syntax.hs b/src/Data/Cfg/Bnf/Syntax.hs --- a/src/Data/Cfg/Bnf/Syntax.hs +++ b/src/Data/Cfg/Bnf/Syntax.hs @@ -2,35 +2,36 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -module Data.Cfg.Bnf.Syntax(Grammar(..)) where -import Data.Cfg.Cfg(Cfg(..), Production, V(..), Vs) -import Data.Data(Data, Typeable) +module Data.Cfg.Bnf.Syntax + ( Grammar(..) + ) where + +import Data.Cfg.Cfg (Cfg(..), Production, V(..), Vs) +import Data.Data (Data, Typeable) import qualified Data.Set as S -- | A simple, concrete instance of 'Cfg'. The terminal and -- nonterminal symbols of a 'Grammar' are defined to be exactly those -- appearing the productions. The start symbol is defined to be the -- head of the first of the productions. -newtype Grammar t nt = Grammar { - grammarProductions :: [Production t nt] - -- ^ the productions of the 'Grammar' - } - deriving (Data, Typeable) +newtype Grammar t nt = Grammar + { grammarProductions :: [Production t nt] + -- ^ the productions of the 'Grammar' + } deriving (Data, Typeable) instance (Ord nt, Ord t) => Cfg Grammar t nt where - terminals = S.fromList . concatMap terminalsProd . grammarProductions - nonterminals = S.fromList . concatMap nonterminalsProd . grammarProductions - productionRules g nt - = S.fromList [ rhs | (nt', rhs) <- grammarProductions g, - nt == nt' ] - startSymbol = fst . head . grammarProductions + terminals = S.fromList . concatMap terminalsProd . grammarProductions + nonterminals = S.fromList . concatMap nonterminalsProd . grammarProductions + productionRules g nt = + S.fromList [rhs | (nt', rhs) <- grammarProductions g, nt == nt'] + startSymbol = fst . head . grammarProductions nonterminalsVs :: Vs t nt -> [nt] -nonterminalsVs vs = [ nt | NT nt <- vs ] +nonterminalsVs vs = [nt | NT nt <- vs] terminalsVs :: Vs t nt -> [t] -terminalsVs vs = [ t | T t <- vs ] +terminalsVs vs = [t | T t <- vs] nonterminalsProd :: Production t nt -> [nt] nonterminalsProd (nt, rhs) = nt : nonterminalsVs rhs diff --git a/src/Data/Cfg/Bnf/Token.hs b/src/Data/Cfg/Bnf/Token.hs --- a/src/Data/Cfg/Bnf/Token.hs +++ b/src/Data/Cfg/Bnf/Token.hs @@ -1,26 +1,25 @@ -- | Bnf tokens -module Data.Cfg.Bnf.Token( - Token(..), - TokenType(..) - ) where +module Data.Cfg.Bnf.Token + ( Token(..) + , TokenType(..) + ) where -- | Token types -data TokenType = ERROR - | FULL_STOP -- ^ @.@ - | LOWER_IDENTIFIER - - -- ^ an identifier made of lower-case characters possibly - -- separated by underscores - - | OR -- ^ @|@ - | UPPER_IDENTIFIER - - -- ^ an identifier made of upper-case characters possibly - -- separated by underscores - - | YIELDS -- ^ @::=@ - deriving (Eq, Show) +data TokenType + = ERROR + | FULL_STOP -- ^ @.@ + | LOWER_IDENTIFIER + -- ^ an identifier made of lower-case characters possibly + -- separated by underscores + | OR -- ^ @|@ + | UPPER_IDENTIFIER + -- ^ an identifier made of upper-case characters possibly + -- separated by underscores + | YIELDS -- ^ @::=@ + deriving (Eq, Show) --- | Basic Bnf tokens. They do not contain location information. -data Token = Token TokenType String +-- | Basic Bnf tokens. They do not contain location information. +data Token = + Token TokenType + String deriving (Eq, Show) diff --git a/src/Data/Cfg/CPretty.hs b/src/Data/Cfg/CPretty.hs --- a/src/Data/Cfg/CPretty.hs +++ b/src/Data/Cfg/CPretty.hs @@ -1,12 +1,15 @@ -- | Pretty-printing that requires a context {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} -module Data.Cfg.CPretty(CPretty(..)) where +module Data.Cfg.CPretty + ( CPretty(..) + ) where + import Control.Monad.Reader import Text.PrettyPrint -- | Pretty-printing that requires a context class CPretty p ctxt where - cpretty :: (MonadReader ctxt m) => p -> m Doc - -- ^ pretty-print in a monad providing the context + cpretty :: (MonadReader ctxt m) => p -> m Doc + -- ^ pretty-print in a monad providing the context diff --git a/src/Data/Cfg/Cfg.hs b/src/Data/Cfg/Cfg.hs --- a/src/Data/Cfg/Cfg.hs +++ b/src/Data/Cfg/Cfg.hs @@ -3,90 +3,88 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} -module Data.Cfg.Cfg( - -- * Class - Cfg(..), + +module Data.Cfg.Cfg + ( -- * Class + Cfg(..) -- * Vocabulary - V(..), - Vs, - isNT, - isT, - bimapV, - bimapVs, - vocabulary, - usedVocabulary, - undeclaredVocabulary, - isFullyDeclared, + , V(..) + , Vs + , isNT + , isT + , bimapV + , bimapVs + , vocabulary + , usedVocabulary + , undeclaredVocabulary + , isFullyDeclared -- * Productions - Production, - productions, + , Production + , productions -- * Utility functions - eqCfg {- , - compareCfg -}) where + , eqCfg {- , + compareCfg -} + ) where -import Control.Monad(liftM4) -import Control.Monad.Reader(ask) +import Control.Monad (liftM4) +import Control.Monad.Reader (ask) import Data.Cfg.CPretty -import Data.Data(Data, Typeable) +import Data.Data (Data, Typeable) import qualified Data.Set as S import Text.PrettyPrint +import qualified Text.PrettyPrint as P ------------------------------------------------------------ - -- | Represents a context-free grammar with its nonterminal and -- terminal types. class Cfg cfg t nt where - nonterminals :: cfg t nt -> S.Set nt - -- ^ the nonterminals of the grammar - terminals :: cfg t nt -> S.Set t - -- ^ the terminals of the grammar - productionRules :: cfg t nt -> nt -> S.Set (Vs t nt) - -- ^ the productions of the grammar - startSymbol :: cfg t nt -> nt - -- ^ the start symbol of the grammar; must be an element of - -- 'nonterminals' 'cfg' + nonterminals :: cfg t nt -> S.Set nt + -- ^ the nonterminals of the grammar + terminals :: cfg t nt -> S.Set t + -- ^ the terminals of the grammar + productionRules :: cfg t nt -> nt -> S.Set (Vs t nt) + -- ^ the productions of the grammar + startSymbol :: cfg t nt -> nt-- ^ the start symbol of the grammar; must be an element of + -- 'nonterminals' 'cfg' instance (Cfg cfg t nt) => CPretty (cfg t nt) (V t nt -> Doc) where - cpretty cfg = liftM4 vcat' ss ts nts prods - where - vcat' a b c d = vcat [a, b, c, d] - ss = do - prettyV <- ask - return (text "Start symbol:" <+> prettyV (NT $ startSymbol cfg)) - ts = do - prettyV <- ask - return (text "Terminals:" - <+> fsep (punctuate comma - $ map (prettyV . T) - (S.toList $ terminals cfg))) - nts = do - prettyV <- ask - return (text "Nonterminals:" - <+> fsep (punctuate comma - $ map (prettyV . NT) - (S.toList $ nonterminals cfg))) - - prods = do - prettyV <- ask - return (text "Productions:" - $$ nest 4 - (vcat (map (prettyProd prettyV) - (zip [1..] $ productions cfg)))) - where - prettyProd pv (n, (hd, rhs)) - = hsep [parens (int n), - pv (NT hd), text "::=", rhs' <> text "."] - where - rhs' = hsep $ map pv rhs + cpretty cfg = liftM4 vcat' ss ts nts prods + where + vcat' a b c d = vcat [a, b, c, d] + ss = do + prettyV <- ask + return (text "Start symbol:" <+> prettyV (NT $ startSymbol cfg)) + ts = do + prettyV <- ask + return + (text "Terminals:" <+> + fsep (punctuate comma $ map (prettyV . T) (S.toList $ terminals cfg))) + nts = do + prettyV <- ask + return + (text "Nonterminals:" <+> + fsep + (punctuate comma $ map (prettyV . NT) (S.toList $ nonterminals cfg))) + prods = do + prettyV <- ask + return + (text "Productions:" $$ + nest + 4 + (vcat (map (prettyProd prettyV) (zip [1 ..] $ productions cfg)))) + where + prettyProd pv (n, (hd, rhs)) = + hsep [parens (int n), pv (NT hd), text "::=", rhs' P.<> text "."] + where + rhs' = hsep $ map pv rhs ------------------------------------------------------------ - ------------------------------------------------------------ - -- | Vocabulary symbols of the grammar. -data V t nt = T t -- ^ a terminal - | NT nt -- ^ a nonterminal - deriving (Eq, Ord, Show, Data, Typeable) +data V t nt + = T t -- ^ a terminal + | NT nt -- ^ a nonterminal + deriving (Eq, Ord, Show, Data, Typeable) -- | Returns 'True' iff the vocabularly symbols is a terminal. isT :: V t nt -> Bool @@ -99,8 +97,8 @@ isNT _ = False instance Functor (V t) where - fmap _f (T t) = T t - fmap f (NT nt) = NT $ f nt + fmap _f (T t) = T t + fmap f (NT nt) = NT $ f nt -- | Maps over the terminal and nonterminal symbols in a 'V'. bimapV :: (t -> t') -> (nt -> nt') -> V t nt -> V t' nt' @@ -110,8 +108,7 @@ -- | Returns the vocabulary symbols of the grammar: elements of -- 'terminals' and 'nonterminals'. vocabulary :: (Cfg cfg t nt, Ord nt, Ord t) => cfg t nt -> S.Set (V t nt) -vocabulary cfg = S.map T (terminals cfg) - `S.union` S.map NT (nonterminals cfg) +vocabulary cfg = S.map T (terminals cfg) `S.union` S.map NT (nonterminals cfg) -- | Synonym for lists of vocabulary symbols. type Vs t nt = [V t nt] @@ -126,57 +123,51 @@ -- | Returns the productions of the grammar. productions :: (Cfg cfg t nt) => cfg t nt -> [Production t nt] productions cfg = do - nt <- S.toList $ nonterminals cfg - vs <- S.toList $ productionRules cfg nt - return (nt, vs) + nt <- S.toList $ nonterminals cfg + vs <- S.toList $ productionRules cfg nt + return (nt, vs) -- | Returns 'True' iff the two inhabitants of 'Cfg' are equal. -eqCfg :: forall cfg cfg' t nt - . (Cfg cfg t nt, Cfg cfg' t nt, Eq nt, Eq t) - => cfg t nt -> cfg' t nt -> Bool +eqCfg :: + forall cfg cfg' t nt. (Cfg cfg t nt, Cfg cfg' t nt, Eq nt, Eq t) + => cfg t nt + -> cfg' t nt + -> Bool eqCfg cfg cfg' = to4Tuple cfg == to4Tuple cfg' {------------------------------------------------------------ -- | Compares the two inhabitants of 'Cfg'. compareCfg :: forall cfg cfg' t nt - . (Cfg cfg t nt, Cfg cfg' t nt, Ord nt, Ord t) - => cfg t nt -> cfg' t nt -> Ordering + . (Cfg cfg t nt, Cfg cfg' t nt, Ord nt, Ord t) + => cfg t nt -> cfg' t nt -> Ordering compareCfg cfg cfg' = compare (to4Tuple cfg) (to4Tuple cfg') ------------------------------------------------------------} - -- | Converts the 'Cfg' to a 4-tuple that inhabits both 'Eq' and 'Ord' -- if 't' and 'nt' do. -to4Tuple :: forall cfg t nt . (Cfg cfg t nt) - => cfg t nt -> (nt, S.Set nt, S.Set t, [Production t nt]) - - -- We move the start symbol first to optimize the operations +to4Tuple :: + forall cfg t nt. (Cfg cfg t nt) + => cfg t nt + -> (nt, S.Set nt, S.Set t, [Production t nt])-- We move the start symbol first to optimize the operations -- since it's most likely to differ. - -to4Tuple cfg = ( - startSymbol cfg, - nonterminals cfg, - terminals cfg, - productions cfg) +to4Tuple cfg = + (startSymbol cfg, nonterminals cfg, terminals cfg, productions cfg) -- | Returns all vocabulary used in the productions plus the start -- symbol. -usedVocabulary :: (Cfg cfg t nt, Ord nt, Ord t) - => cfg t nt -> S.Set (V t nt) -usedVocabulary cfg - = S.fromList - $ NT (startSymbol cfg) : - concat [ NT nt : vs | (nt, vs) <- productions cfg] +usedVocabulary :: (Cfg cfg t nt, Ord nt, Ord t) => cfg t nt -> S.Set (V t nt) +usedVocabulary cfg = + S.fromList $ + NT (startSymbol cfg) : concat [NT nt : vs | (nt, vs) <- productions cfg] -- | Returns all vocabulary used in the productions plus the start -- symbol but not declared in 'nonterminals' or 'terminals'. -undeclaredVocabulary :: (Cfg cfg t nt, Ord nt, Ord t) - => cfg t nt -> S.Set (V t nt) +undeclaredVocabulary :: + (Cfg cfg t nt, Ord nt, Ord t) => cfg t nt -> S.Set (V t nt) undeclaredVocabulary cfg = usedVocabulary cfg S.\\ vocabulary cfg ------------------------------------------------------------ - -- | Returns 'True' all the vocabulary used in the grammar is -- declared. isFullyDeclared :: (Cfg cfg t nt, Ord nt, Ord t) => cfg t nt -> Bool diff --git a/src/Data/Cfg/Collect.hs b/src/Data/Cfg/Collect.hs --- a/src/Data/Cfg/Collect.hs +++ b/src/Data/Cfg/Collect.hs @@ -1,39 +1,38 @@ -- | Data-shuffling -module Data.Cfg.Collect ( - collectOnFirst, - collectOnSecond, - collectOnFirst', - collectOnSecond' - ) where +module Data.Cfg.Collect + ( collectOnFirst + , collectOnSecond + , collectOnFirst' + , collectOnSecond' + ) where -import Data.List(nub) +import Data.List (nub) import qualified Data.Set as S -- | Collects a list of pairs on the first element. collectOnFirst :: Eq a => [(a, b)] -> [(a, [b])] collectOnFirst pairs = [(a, bsFor a) | a <- as] - where + where as = nub $ map fst pairs - bsFor a = [ b | (a', b) <- pairs, a == a' ] + bsFor a = [b | (a', b) <- pairs, a == a'] -- | Collects a list of pairs on the second element. collectOnSecond :: Eq b => [(a, b)] -> [([a], b)] collectOnSecond pairs = [(asFor b, b) | b <- bs] - where + where bs = nub $ map snd pairs - asFor b = [ a | (a, b') <- pairs, b == b' ] + asFor b = [a | (a, b') <- pairs, b == b'] -- | Collects a list of pairs on the first element. collectOnFirst' :: (Eq a, Ord b) => [(a, b)] -> [(a, S.Set b)] collectOnFirst' pairs = [(a, bsFor a) | a <- as] - where + where as = nub $ map fst pairs - bsFor a = S.fromList [ b | (a', b) <- pairs, a == a' ] + bsFor a = S.fromList [b | (a', b) <- pairs, a == a'] -- | Collects a list of pairs on the second element. collectOnSecond' :: (Ord a, Eq b) => [(a, b)] -> [(S.Set a, b)] collectOnSecond' pairs = [(asFor b, b) | b <- bs] - where + where bs = nub $ map snd pairs - asFor b = S.fromList [ a | (a, b') <- pairs, b == b' ] - + asFor b = S.fromList [a | (a, b') <- pairs, b == b'] diff --git a/src/Data/Cfg/FixedPoint.hs b/src/Data/Cfg/FixedPoint.hs --- a/src/Data/Cfg/FixedPoint.hs +++ b/src/Data/Cfg/FixedPoint.hs @@ -1,12 +1,15 @@ -- | The iterative fixed-point function. -module Data.Cfg.FixedPoint(fixedPoint) where +module Data.Cfg.FixedPoint + ( fixedPoint + ) where -- | Given a function and an initial value, find the fixed point of -- the function. fixedPoint :: Eq a => (a -> a) -> a -> a fixedPoint f a = go $ iterate f a - where - go as@(a' : a'' : _) = if a' == a'' - then a' - else go $ tail as + where + go as@(a':a'':_) = + if a' == a'' + then a' + else go $ tail as go _ = error "fixedPoint: impossible" diff --git a/src/Data/Cfg/FreeCfg.hs b/src/Data/Cfg/FreeCfg.hs --- a/src/Data/Cfg/FreeCfg.hs +++ b/src/Data/Cfg/FreeCfg.hs @@ -1,40 +1,42 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} + -- | The free 'Cfg' -module Data.Cfg.FreeCfg ( - FreeCfg(..), - toFreeCfg - ) where +module Data.Cfg.FreeCfg + ( FreeCfg(..) + , toFreeCfg + ) where -import Data.Cfg.Cfg(Cfg(..), Vs) +import Data.Cfg.Cfg (Cfg(..), Vs) import qualified Data.Set as S -- | Represents a context-free grammar with its nonterminal and -- terminal types. The canonical instance of 'Cfg': a record that -- collects up implementations of each class method. -data FreeCfg t nt = FreeCfg { - nonterminals' :: S.Set nt, - -- ^ the nonterminals of the grammar - terminals' :: S.Set t, - -- ^ the terminals of the grammar - productionRules' :: nt -> S.Set (Vs t nt), - -- ^ the productions of the grammar - startSymbol' :: nt - -- ^ the start symbol of the grammar; must be an element of - -- 'nonterminals' 'cfg' - } +data FreeCfg t nt = FreeCfg + { nonterminals' :: S.Set nt + -- ^ the nonterminals of the grammar + , terminals' :: S.Set t + -- ^ the terminals of the grammar + , productionRules' :: nt -> S.Set (Vs t nt) + -- ^ the productions of the grammar + , startSymbol' :: nt + -- ^ the start symbol of the grammar; must be an element of + -- 'nonterminals' 'cfg' + } instance Cfg FreeCfg t nt where - nonterminals = nonterminals' - terminals = terminals' - productionRules = productionRules' - startSymbol = startSymbol' + nonterminals = nonterminals' + terminals = terminals' + productionRules = productionRules' + startSymbol = startSymbol' -- | Converts any 'Cfg' into a 'FreeCfg'. toFreeCfg :: Cfg cfg t nt => cfg t nt -> FreeCfg t nt -toFreeCfg cfg = FreeCfg { - nonterminals' = nonterminals cfg, - terminals' = terminals cfg, - productionRules' = productionRules cfg, - startSymbol' = startSymbol cfg +toFreeCfg cfg = + FreeCfg + { nonterminals' = nonterminals cfg + , terminals' = terminals cfg + , productionRules' = productionRules cfg + , startSymbol' = startSymbol cfg } diff --git a/src/Data/Cfg/Internal/FirstSet.hs b/src/Data/Cfg/Internal/FirstSet.hs --- a/src/Data/Cfg/Internal/FirstSet.hs +++ b/src/Data/Cfg/Internal/FirstSet.hs @@ -1,50 +1,57 @@ -- | First sets of a context-free grammar. {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} -module Data.Cfg.Internal.FirstSet(firstSetMap, firstsOfVs) where +module Data.Cfg.Internal.FirstSet + ( firstSetMap + , firstsOfVs + ) where + import Data.Cfg.Augment import Data.Cfg.Cfg -import Data.Cfg.FixedPoint(fixedPoint) -import Data.Cfg.LookaheadSet hiding(unions) +import Data.Cfg.FixedPoint (fixedPoint) +import Data.Cfg.LookaheadSet hiding (unions) import qualified Data.Cfg.LookaheadSet as LA import qualified Data.Map.Strict as M -import Data.Maybe(fromMaybe) -import Data.Monoid(Monoid(mconcat)) +import Data.Maybe (fromMaybe) +import Data.Monoid (Monoid(..)) import qualified Data.Set as S -- | Returns the first set of the nonterminal for the grammar as a -- map. -firstSetMap :: forall cfg t nt - . (Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t) - => cfg (AugT t) (AugNT nt) -> M.Map (AugNT nt) (LookaheadSet t) +firstSetMap :: + forall cfg t nt. (Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t) + => cfg (AugT t) (AugNT nt) + -> M.Map (AugNT nt) (LookaheadSet t) firstSetMap cfg = fixedPoint go M.empty - where - go :: M.Map (AugNT nt) (LookaheadSet t) - -> M.Map (AugNT nt) (LookaheadSet t) - go knownFirsts - = M.fromList [(nt, firstAlts rhss) - | nt <- S.toList $ nonterminals cfg, - let rhss = S.toList $ productionRules cfg nt, - not $ null rhss ] - where - firstAlts :: [Vs (AugT t) (AugNT nt)] -> LookaheadSet t - firstAlts = LA.unions . map (mconcat . map (firstsV knownFirsts)) + where + go :: M.Map (AugNT nt) (LookaheadSet t) -> M.Map (AugNT nt) (LookaheadSet t) + go knownFirsts = + M.fromList + [ (nt, firstAlts rhss) + | nt <- S.toList $ nonterminals cfg + , let rhss = S.toList $ productionRules cfg nt + , not $ null rhss + ] + where + firstAlts :: [Vs (AugT t) (AugNT nt)] -> LookaheadSet t + firstAlts = LA.unions . map (mconcat . map (firstsV knownFirsts)) -firstsV :: Ord nt - => M.Map (AugNT nt) (LookaheadSet t) -> V (AugT t) (AugNT nt) - -> LookaheadSet t +firstsV :: + Ord nt + => M.Map (AugNT nt) (LookaheadSet t) + -> V (AugT t) (AugNT nt) + -> LookaheadSet t firstsV _ (T t) = LA.singleton t firstsV fs (NT nt) = fromMaybe LA.empty (M.lookup nt fs) - -- TODO I need a consistent story here of what I define and - -- export. FollowSet needs this one below, but you can see the + -- export. FollowSet needs this one below, but you can see the -- code duplication with firstsV. Resolve. -- | Given a firsts function, find the first set of a list of symbols. -firstsOfVs :: Ord t - => (AugNT nt -> LookaheadSet t) -> AugVs t nt -> LookaheadSet t +firstsOfVs :: + Ord t => (AugNT nt -> LookaheadSet t) -> AugVs t nt -> LookaheadSet t firstsOfVs firsts vs = mconcat $ map firstsV' vs - where + where firstsV' (T t) = LA.singleton t firstsV' (NT nt) = firsts nt diff --git a/src/Data/Cfg/Internal/FollowSet.hs b/src/Data/Cfg/Internal/FollowSet.hs --- a/src/Data/Cfg/Internal/FollowSet.hs +++ b/src/Data/Cfg/Internal/FollowSet.hs @@ -1,81 +1,92 @@ -- | Follow sets of a context-free grammar. {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} -module Data.Cfg.Internal.FollowSet(followSetMap) where -import Control.Monad(guard) +module Data.Cfg.Internal.FollowSet + ( followSetMap + ) where + +import Control.Monad (guard) import Data.Cfg.Augment import Data.Cfg.Cfg -import Data.Cfg.Collect(collectOnFirst) -import Data.Cfg.Internal.FirstSet(firstsOfVs) -import Data.Cfg.FixedPoint(fixedPoint) -import Data.List(tails) -import Data.Cfg.LookaheadSet hiding(unions) +import Data.Cfg.Collect (collectOnFirst) +import Data.Cfg.FixedPoint (fixedPoint) +import Data.Cfg.Internal.FirstSet (firstsOfVs) +import Data.Cfg.LookaheadSet hiding (unions) import qualified Data.Cfg.LookaheadSet as LA +import Data.List (tails) import qualified Data.Map.Strict as M +import Data.Monoid (Monoid(..)) +import Data.Semigroup (Semigroup(..)) import qualified Data.Set as S --- | Represents the environment following a nonterminal symbol. A +-- | Represents the environment following a nonterminal symbol. A -- production @foo ::= bar @ will contribute a 'FollowSite' record -- with @ntTail == @ and @prodHead == foo@, where @@ is a -- (possibly empty) list of vocabulary symbols. -data FollowSite t nt = FollowSite { - ntTail :: AugVs t nt, - prodHead :: AugNT nt - } +data FollowSite t nt = FollowSite + { ntTail :: AugVs t nt + , prodHead :: AugNT nt + } -- | Calculates a map that gives all the follow sites in the grammar -- for the given nonterminal. -followSitesMap :: (Cfg cfg (AugT t) (AugNT nt), Ord nt) - => cfg (AugT t) (AugNT nt) - -> M.Map (AugNT nt) [FollowSite t nt] -followSitesMap cfg = M.fromList . collectOnFirst $ do +followSitesMap :: + (Cfg cfg (AugT t) (AugNT nt), Ord nt) + => cfg (AugT t) (AugNT nt) + -> M.Map (AugNT nt) [FollowSite t nt] +followSitesMap cfg = + M.fromList . collectOnFirst $ do prodHd <- S.toList $ nonterminals cfg let rhss = S.toList $ productionRules cfg prodHd guard (not $ null rhss) rhs <- rhss - NT nt : tl <- tails rhs - return (nt, FollowSite { ntTail = tl, prodHead = prodHd }) + NT nt:tl <- tails rhs + return (nt, FollowSite {ntTail = tl, prodHead = prodHd}) -- | Given what we know of firsts and follows, find the first set of a -- follow site. -firstsOfFollowSite :: forall t nt . (Ord t, Ord nt) - => (AugNT nt -> LookaheadSet t) - -> M.Map (AugNT nt) (LookaheadSet t) - -> FollowSite t nt - -> LookaheadSet t -firstsOfFollowSite firsts knownFollows followSite - = firstsOfNTTail <> firstsOfProdHead - where - firstsOfNTTail, firstsOfProdHead :: LookaheadSet t +firstsOfFollowSite :: + forall t nt. (Ord t, Ord nt) + => (AugNT nt -> LookaheadSet t) + -> M.Map (AugNT nt) (LookaheadSet t) + -> FollowSite t nt + -> LookaheadSet t +firstsOfFollowSite firsts knownFollows followSite = + firstsOfNTTail <> firstsOfProdHead + where + firstsOfNTTail, firstsOfProdHead :: LookaheadSet t firstsOfNTTail = firstsOfVs firsts (ntTail followSite) firstsOfProdHead = knownFollows M.! prodHead followSite -- | Returns the follow sets for the grammar as a map. -followSetMap :: forall cfg t nt - . (Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t) - => cfg (AugT t) (AugNT nt) - -- ^ the grammar - -> (AugNT nt -> LookaheadSet t) - -- ^ 'firstSet' for the grammar - -> M.Map (AugNT nt) (LookaheadSet t) +followSetMap :: + forall cfg t nt. (Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t) + => cfg (AugT t) (AugNT nt) + -- ^ the grammar + -> (AugNT nt -> LookaheadSet t) + -- ^ 'firstSet' for the grammar + -> M.Map (AugNT nt) (LookaheadSet t) followSetMap cfg fs = fixedPoint go initMap - where - go :: M.Map (AugNT nt) (LookaheadSet t) - -> M.Map (AugNT nt) (LookaheadSet t) - go oldFols = M.mapWithKey (\ k v -> LA.unions $ f k v) oldFols - where - f :: AugNT nt -> LookaheadSet t -> [LookaheadSet t] - f nt oldFollows = oldFollows : map (firstsOfFollowSite fs oldFols) folSites - where - folSites = M.findWithDefault [] nt followSitesMap' - + where + go :: M.Map (AugNT nt) (LookaheadSet t) -> M.Map (AugNT nt) (LookaheadSet t) + go oldFols = M.mapWithKey (\k v -> LA.unions $ f k v) oldFols + where + f :: AugNT nt -> LookaheadSet t -> [LookaheadSet t] + f nt oldFollows = + oldFollows : map (firstsOfFollowSite fs oldFols) folSites + where + folSites = M.findWithDefault [] nt followSitesMap' initMap :: M.Map (AugNT nt) (LookaheadSet t) - initMap = M.fromList [(nt, case nt of - StartSymbol -> singleton EOF - _ -> empty) | nt <- nts] - where + initMap = + M.fromList + [ ( nt + , case nt of + StartSymbol -> singleton EOF + _ -> empty) + | nt <- nts + ] + where nts = S.toList $ nonterminals cfg - followSitesMap' :: M.Map (AugNT nt) [FollowSite t nt] followSitesMap' = followSitesMap cfg diff --git a/src/Data/Cfg/Internal/Nullable.hs b/src/Data/Cfg/Internal/Nullable.hs --- a/src/Data/Cfg/Internal/Nullable.hs +++ b/src/Data/Cfg/Internal/Nullable.hs @@ -1,29 +1,33 @@ -- | Nullable nonterminals {-# LANGUAGE ScopedTypeVariables #-} -module Data.Cfg.Internal.Nullable(nullables) where -import Control.Monad(guard) +module Data.Cfg.Internal.Nullable + ( nullables + ) where + +import Control.Monad (guard) import Data.Cfg.Cfg -import Data.Cfg.FixedPoint(fixedPoint) +import Data.Cfg.FixedPoint (fixedPoint) import qualified Data.Set as S -- | Returns the nonterminals in the grammar that can produce the -- empty string. -nullables :: forall cfg t nt . (Cfg cfg t nt, Ord nt) - => cfg t nt -> S.Set nt +nullables :: + forall cfg t nt. (Cfg cfg t nt, Ord nt) + => cfg t nt + -> S.Set nt nullables cfg = fixedPoint go S.empty - where + where go :: S.Set nt -> S.Set nt go knownNullables = calculatedNullables - where - isKnownNullable :: V t nt -> Bool - isKnownNullable (NT nm) = nm `S.member` knownNullables - isKnownNullable _ = False - - calculatedNullables :: S.Set nt - calculatedNullables = S.fromList $ do - nt <- S.toList $ nonterminals cfg - let rhss = S.toList $ productionRules cfg nt - guard $ any (all isKnownNullable) rhss + where + isKnownNullable :: V t nt -> Bool + isKnownNullable (NT nm) = nm `S.member` knownNullables + isKnownNullable _ = False + calculatedNullables :: S.Set nt + calculatedNullables = + S.fromList $ do + nt <- S.toList $ nonterminals cfg + let rhss = S.toList $ productionRules cfg nt + guard $ any (all isKnownNullable) rhss return nt - diff --git a/src/Data/Cfg/Internal/PredictSet.hs b/src/Data/Cfg/Internal/PredictSet.hs --- a/src/Data/Cfg/Internal/PredictSet.hs +++ b/src/Data/Cfg/Internal/PredictSet.hs @@ -1,30 +1,34 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} + -- | Predict sets of a context-free grammar. -module Data.Cfg.Internal.PredictSet ( - Prediction, - Predictions, - predictSet, - ll1InfoMap, - isLL1 - ) where +module Data.Cfg.Internal.PredictSet + ( Prediction + , Predictions + , predictSet + , ll1InfoMap + , isLL1 + ) where import Data.Cfg.Augment -import Data.Cfg.Cfg(Cfg(..)) +import Data.Cfg.Cfg (Cfg(..)) import Data.Cfg.Collect -import Data.Cfg.Internal.FirstSet(firstsOfVs) +import Data.Cfg.Internal.FirstSet (firstsOfVs) import Data.Cfg.LookaheadSet import qualified Data.Map.Strict as M +import Data.Monoid (Monoid(..)) +import Data.Semigroup (Semigroup(..)) import qualified Data.Set as S -- | Returns the predict set of a production. -predictSet :: (Ord t) - => (AugNT nt -> LookaheadSet t) -- ^ 'firstSet' for the grammar - -> (AugNT nt -> LookaheadSet t) -- ^ 'followSet' for the grammar - -> AugProduction t nt -- ^ the production - -> LookaheadSet t -predictSet firstSet' followSet' (hd, vs) - = firstsOfVs firstSet' vs <> followSet' hd +predictSet :: + (Ord t) + => (AugNT nt -> LookaheadSet t) -- ^ 'firstSet' for the grammar + -> (AugNT nt -> LookaheadSet t) -- ^ 'followSet' for the grammar + -> AugProduction t nt -- ^ the production + -> LookaheadSet t +predictSet firstSet' followSet' (hd, vs) = + firstsOfVs firstSet' vs <> followSet' hd -- | A lookahead set with the productions it predicts type Prediction t nt = (LookaheadSet t, S.Set (AugProduction t nt)) @@ -34,34 +38,32 @@ type Predictions t nt = S.Set (Prediction t nt) -- | Returns the production 'Predictions' for the grammar as a map. -ll1InfoMap :: forall cfg t nt - . (Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t) - => cfg (AugT t) (AugNT nt) - -> (AugProduction t nt -> LookaheadSet t) - -> M.Map (AugNT nt) (Predictions t nt) +ll1InfoMap :: + forall cfg t nt. (Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t) + => cfg (AugT t) (AugNT nt) + -> (AugProduction t nt -> LookaheadSet t) + -> M.Map (AugNT nt) (Predictions t nt) ll1InfoMap cfg predictSet' = mkMap mkPredictions $ S.toList $ nonterminals cfg - where + where mkPredictions :: AugNT nt -> Predictions t nt - -- Mostly reshuffling data - mkPredictions nt - = S.fromList $ f $ collectOnSecond $ collectOnFirst' lookaheadProds - where - -- Possible lookahead symbols for productions of this nonterminal - lookaheadProds :: [(AugT t, AugProduction t nt)] - lookaheadProds = do - rhs <- S.toList $ productionRules cfg nt - let prod = (nt, rhs) - t <- S.toList $ toSet $ predictSet' prod - return (t, prod) - - f :: [([AugT t], S.Set (AugProduction t nt))] - -> [(LookaheadSet t, S.Set (AugProduction t nt))] - f pairs = [(fromList la, ps) | (la, ps) <- pairs] - + -- Mostly reshuffling data + mkPredictions nt = + S.fromList $ f $ collectOnSecond $ collectOnFirst' lookaheadProds + -- Possible lookahead symbols for productions of this nonterminal + where + lookaheadProds :: [(AugT t, AugProduction t nt)] + lookaheadProds = do + rhs <- S.toList $ productionRules cfg nt + let prod = (nt, rhs) + t <- S.toList $ toSet $ predictSet' prod + return (t, prod) + f :: [([AugT t], S.Set (AugProduction t nt))] + -> [(LookaheadSet t, S.Set (AugProduction t nt))] + f pairs = [(fromList la, ps) | (la, ps) <- pairs] mkMap :: Ord k => (k -> v) -> [k] -> M.Map k v mkMap f ks = M.fromList [(k, f k) | k <- ks] -- | Returns true iff the predictions are unambiguous, true iff the -- grammar is LL(1). isLL1 :: M.Map (AugNT nt) (Predictions t nt) -> Bool -isLL1 m = all (\ ps -> S.size ps == 1) $ M.elems m +isLL1 m = all (\ps -> S.size ps == 1) $ M.elems m diff --git a/src/Data/Cfg/LookaheadSet.hs b/src/Data/Cfg/LookaheadSet.hs --- a/src/Data/Cfg/LookaheadSet.hs +++ b/src/Data/Cfg/LookaheadSet.hs @@ -1,44 +1,50 @@ -- | Sets of lookahead symbols. -module Data.Cfg.LookaheadSet ( - LookaheadSet, - mkLookaheadSet, - fromList, - toSet, - (<>), -- reexport +module Data.Cfg.LookaheadSet + ( LookaheadSet + , mkLookaheadSet + , fromList + , toSet -- * Set operations - empty, - singleton, - unions - ) where + , empty + , singleton + , unions + ) where -import Data.Cfg.Augment(AugT(..)) -import Data.Monoid(Monoid(..), (<>)) +import Data.Cfg.Augment (AugT(..)) +import Data.Monoid (Monoid(..)) +import Data.Semigroup (Semigroup(..)) import qualified Data.Set as S -- | Set of lookahead symbols providing different 'Monoid' semantics --- than 'Data.Set.Set'. ('mappend' implements concatenation, not set +-- than 'Data.Set.Set'. ('mappend' implements concatenation, not set -- union.) -newtype LookaheadSet t = LookaheadSet { - toSet :: S.Set (AugT t) - -- ^ Converts the 'LookaheadSet' to a regular 'Data.Set.Set' - } - deriving (Eq, Ord, Show) +newtype LookaheadSet t = LookaheadSet + { toSet :: S.Set (AugT t) + -- ^ Converts the 'LookaheadSet' to a regular 'Data.Set.Set' + } deriving (Eq, Ord, Show) +instance Ord t => Semigroup (LookaheadSet t) where + l@(LookaheadSet s) <> LookaheadSet s' = + if EOF `S.member` s + then LookaheadSet $ S.delete EOF s `S.union` s' + else l + instance Ord t => Monoid (LookaheadSet t) where - mempty = LookaheadSet $ S.singleton EOF - l@(LookaheadSet s) `mappend` LookaheadSet s' - = if EOF `S.member` s - then LookaheadSet $ S.delete EOF s `S.union` s' - else l + mempty = LookaheadSet $ S.singleton EOF + mappend = (<>) -- | Creates a 'LookaheadSet' -mkLookaheadSet :: (Ord t) - => Bool -- ^ true iff it has 'EOF' - -> [t] -- ^ terminal symbols - -> LookaheadSet t +mkLookaheadSet :: + (Ord t) + => Bool -- ^ true iff it has 'EOF' + -> [t] -- ^ terminal symbols + -> LookaheadSet t mkLookaheadSet hasEOF = LookaheadSet . S.fromList . f . map AugT - where - f = if hasEOF then (EOF:) else id + where + f = + if hasEOF + then (EOF :) + else id -- | Creates a 'LookaheadSet' from a list of augmented terminals. fromList :: Ord t => [AugT t] -> LookaheadSet t diff --git a/src/Data/Cfg/Productive.hs b/src/Data/Cfg/Productive.hs --- a/src/Data/Cfg/Productive.hs +++ b/src/Data/Cfg/Productive.hs @@ -1,87 +1,93 @@ -- | Productivity of productions in the grammar. {-# LANGUAGE ScopedTypeVariables #-} -module Data.Cfg.Productive ( - productives, - unproductives, - removeUnproductives - ) where -import Control.Monad(guard, unless) -import Data.Cfg.Cfg(Cfg(..), Production, V(..), Vs, productions) -import Data.Cfg.FixedPoint(fixedPoint) -import Data.Cfg.FreeCfg(FreeCfg(..)) +module Data.Cfg.Productive + ( productives + , unproductives + , removeUnproductives + ) where + +import Control.Monad (guard, unless) +import Data.Cfg.Cfg (Cfg(..), Production, V(..), Vs, productions) +import Data.Cfg.FixedPoint (fixedPoint) +import Data.Cfg.FreeCfg (FreeCfg(..)) import qualified Data.Set as S -- | Returns the productive productions of this grammar. -productives :: forall cfg t nt - . (Cfg cfg t nt, Ord nt, Ord t) - => cfg t nt -> S.Set (Production t nt) -productives cfg = S.fromList - $ filter (isProductiveProduction productiveNTs) - $ productions cfg - where +productives :: + forall cfg t nt. (Cfg cfg t nt, Ord nt, Ord t) + => cfg t nt + -> S.Set (Production t nt) +productives cfg = + S.fromList $ filter (isProductiveProduction productiveNTs) $ productions cfg + where productiveNTs :: S.Set nt productiveNTs = productiveNonterminals cfg -- | Returns the unproductive productions of this grammar. -unproductives :: forall cfg t nt - . (Cfg cfg t nt, Ord nt, Ord t) - => cfg t nt -> S.Set (Production t nt) +unproductives :: + forall cfg t nt. (Cfg cfg t nt, Ord nt, Ord t) + => cfg t nt + -> S.Set (Production t nt) unproductives cfg = S.fromList (productions cfg) S.\\ productives cfg -- | Returns an equivalent grammar not including unproductive -- productions. -removeUnproductives :: forall cfg t nt - . (Cfg cfg t nt, Ord nt, Ord t) - => cfg t nt -> FreeCfg t nt -removeUnproductives cfg = FreeCfg { - terminals' = terminals cfg, - startSymbol' = startSymbol cfg, - nonterminals' = nts, - productionRules' = rules +removeUnproductives :: + forall cfg t nt. (Cfg cfg t nt, Ord nt, Ord t) + => cfg t nt + -> FreeCfg t nt +removeUnproductives cfg = + FreeCfg + { terminals' = terminals cfg + , startSymbol' = startSymbol cfg + , nonterminals' = nts + , productionRules' = rules } - where + where nts :: S.Set nt nts = productiveNonterminals cfg - rules :: nt -> S.Set (Vs t nt) - rules nt = if nt `S.member` nts - then S.filter (isProductiveVs nts) $ productionRules cfg nt - else S.empty + rules nt = + if nt `S.member` nts + then S.filter (isProductiveVs nts) $ productionRules cfg nt + else S.empty -- | Returns the productive nonterminals of the grammar -productiveNonterminals :: forall cfg t nt - . (Cfg cfg t nt, Ord nt, Ord t) - => cfg t nt -> S.Set nt +productiveNonterminals :: + forall cfg t nt. (Cfg cfg t nt, Ord nt, Ord t) + => cfg t nt + -> S.Set nt productiveNonterminals cfg = fixedPoint f S.empty - where + where f :: S.Set nt -> S.Set nt - f productiveNTs = S.fromList $ do - nt <- S.toList $ nonterminals cfg - unless (nt `S.member` productiveNTs) $ do - let rhss = productionRules cfg nt - guard (any (isProductiveVs productiveNTs) $ S.toList rhss) - return nt + f productiveNTs = + S.fromList $ do + nt <- S.toList $ nonterminals cfg + unless (nt `S.member` productiveNTs) $ do + let rhss = productionRules cfg nt + guard (any (isProductiveVs productiveNTs) $ S.toList rhss) + return nt -isProductiveProduction :: forall t nt - . (Ord nt) - => S.Set nt -> Production t nt -> Bool -isProductiveProduction productiveNTs (hd, rhs) - = hd `S.member` productiveNTs - && isProductiveVs productiveNTs rhs +isProductiveProduction :: + forall t nt. (Ord nt) + => S.Set nt + -> Production t nt + -> Bool +isProductiveProduction productiveNTs (hd, rhs) = + hd `S.member` productiveNTs && isProductiveVs productiveNTs rhs -- | Given a set of known productive nonterminals, is the vocabulary -- symbol productive? -isProductiveVs :: forall t nt - . (Ord nt) - => S.Set nt -> Vs t nt -> Bool +isProductiveVs :: + forall t nt. (Ord nt) + => S.Set nt + -> Vs t nt + -> Bool isProductiveVs productiveNTs = all isProductiveV - where - -- | Given a set of known productive nonterminals, is the vocabulary - -- symbol productive? + where isProductiveV :: V t nt -> Bool - isProductiveV v = case v of + isProductiveV v = + case v of NT nt -> nt `S.member` productiveNTs _ -> True - - diff --git a/src/Data/Cfg/Reachable.hs b/src/Data/Cfg/Reachable.hs --- a/src/Data/Cfg/Reachable.hs +++ b/src/Data/Cfg/Reachable.hs @@ -1,55 +1,60 @@ -- | Reachability of nonterminals in the grammar. {-# LANGUAGE ScopedTypeVariables #-} -module Data.Cfg.Reachable ( - reachables, - unreachables, - removeUnreachables - ) where -import Data.Cfg.Cfg(Cfg(..), V(..), Vs) -import Data.Cfg.FreeCfg(FreeCfg(..)) +module Data.Cfg.Reachable + ( reachables + , unreachables + , removeUnreachables + ) where + +import Data.Cfg.Cfg (Cfg(..), V(..), Vs) +import Data.Cfg.FreeCfg (FreeCfg(..)) import qualified Data.Set as S -- | Returns the nonterminals of this grammar reachable from the start -- symbol. -reachables :: forall cfg t nt . (Cfg cfg t nt, Ord nt) - => cfg t nt -> S.Set nt +reachables :: + forall cfg t nt. (Cfg cfg t nt, Ord nt) + => cfg t nt + -> S.Set nt reachables cfg = go [startSymbol cfg] S.empty - where + where go :: [nt] -> S.Set nt -> S.Set nt go [] seen = seen - go (nt : nts) seen - = if nt `S.member` seen - then go nts seen - else do - let seen' = S.insert nt seen - let vs = concat $ S.toList $ productionRules cfg nt - go (nts ++ [nt' | NT nt' <- vs]) seen' + go (nt:nts) seen = + if nt `S.member` seen + then go nts seen + else do + let seen' = S.insert nt seen + let vs = concat $ S.toList $ productionRules cfg nt + go (nts ++ [nt' | NT nt' <- vs]) seen' -- | Returns the nonterminals of this grammar unreachable from the -- start symbol. -unreachables :: forall cfg t nt . (Cfg cfg t nt, Ord nt) - => cfg t nt -> S.Set nt +unreachables :: + forall cfg t nt. (Cfg cfg t nt, Ord nt) + => cfg t nt + -> S.Set nt unreachables cfg = nonterminals cfg S.\\ reachables cfg - -- | Returns an equivalent grammar not including unreachable -- nonterminals. -removeUnreachables :: forall cfg t nt . (Cfg cfg t nt, Ord nt) - => cfg t nt -> FreeCfg t nt -removeUnreachables cfg = FreeCfg { - nonterminals' = res, - terminals' = terminals cfg, - productionRules' = pr, - startSymbol' = startSymbol cfg +removeUnreachables :: + forall cfg t nt. (Cfg cfg t nt, Ord nt) + => cfg t nt + -> FreeCfg t nt +removeUnreachables cfg = + FreeCfg + { nonterminals' = res + , terminals' = terminals cfg + , productionRules' = pr + , startSymbol' = startSymbol cfg } - where + where res :: S.Set nt res = reachables cfg - pr :: nt -> S.Set (Vs t nt) - pr nt = if nt `S.member` res - then productionRules cfg nt - else S.empty - - + pr nt = + if nt `S.member` res + then productionRules cfg nt + else S.empty diff --git a/src/Data/Cfg/RuleApplication.hs b/src/Data/Cfg/RuleApplication.hs --- a/src/Data/Cfg/RuleApplication.hs +++ b/src/Data/Cfg/RuleApplication.hs @@ -1,12 +1,13 @@ -- | Results of application of the production rules of a grammar. {-# LANGUAGE ScopedTypeVariables #-} -module Data.Cfg.RuleApplication( - language, - yields, - directlyYields - ) where -import Control.Monad(liftM, msum) +module Data.Cfg.RuleApplication + ( language + , yields + , directlyYields + ) where + +import Control.Monad (msum) import Control.Monad.Omega import Data.Cfg.Cfg import qualified Data.DList as DL @@ -18,49 +19,41 @@ -- one nonterminal in the string. directlyYields :: (Cfg cfg t nt) => cfg t nt -> Vs t nt -> [Vs t nt] directlyYields cfg vs = do - i <- [0..length vs - 1] - let (pre, NT nt : post) = splitAt i vs - expansion <- S.toList $ productionRules cfg nt - return (pre ++ expansion ++ post) + i <- [0 .. length vs - 1] + let (pre, NT nt:post) = splitAt i vs + expansion <- S.toList $ productionRules cfg nt + return (pre ++ expansion ++ post) -- | Given a grammar, returns all strings yielded by application of -- production rules. -yields :: forall cfg t nt . (Cfg cfg t nt, Ord nt) - => cfg t nt -> [Vs t nt] +yields :: + forall cfg t nt. (Cfg cfg t nt, Ord nt) + => cfg t nt + -> [Vs t nt] yields cfg = map DL.toList $ runOmega $ yieldNT (startSymbol cfg) - where + where yieldNT :: nt -> Omega (DL.DList (V t nt)) yieldNT nt = memoMap M.! nt - where - memoMap :: M.Map nt (Omega (DL.DList (V t nt))) - memoMap = M.fromList - [(nt', yieldNT' nt') - | nt' <- S.toList $ nonterminals cfg] - - yieldNT' :: nt -> Omega (DL.DList (V t nt)) - yieldNT' nt' = msum (return (DL.singleton (NT nt')) - : map yieldVs rhss) - where - rhss = S.toList $ productionRules cfg nt' - - - yieldV :: V t nt -> Omega (DL.DList (V t nt)) - yieldV v = case v of - NT nt -> yieldNT nt - t -> return $ DL.singleton t - - yieldVs :: Vs t nt -> Omega (DL.DList (V t nt)) - yieldVs = liftM DL.concat . mapM yieldV - + where + memoMap :: M.Map nt (Omega (DL.DList (V t nt))) + memoMap = + M.fromList [(nt', yieldNT' nt') | nt' <- S.toList $ nonterminals cfg] + yieldNT' :: nt -> Omega (DL.DList (V t nt)) + yieldNT' nt' = msum (return (DL.singleton (NT nt')) : map yieldVs rhss) + where + rhss = S.toList $ productionRules cfg nt' + yieldV :: V t nt -> Omega (DL.DList (V t nt)) + yieldV v = + case v of + NT nt' -> yieldNT nt' + t -> return $ DL.singleton t + yieldVs :: Vs t nt -> Omega (DL.DList (V t nt)) + yieldVs = fmap DL.concat . mapM yieldV -- NOTE: you shouldn't get symbol strings repeating if the grammar is -- unambiguous. - -- | Given a grammar, returns all strings of terminals yielded by -- application of the production rules to the start symbol. This is -- the /language/ of the grammar. -language :: (Cfg cfg t nt, Ord nt) => cfg t nt -> [Vs t nt] - -- TODO There's certainly a more efficient way to do this. +language :: (Cfg cfg t nt, Ord nt) => cfg t nt -> [Vs t nt]-- TODO There's certainly a more efficient way to do this. language = filter (all isT) . yields - - diff --git a/tests/Data/Cfg/BnfTests.hs b/tests/Data/Cfg/BnfTests.hs --- a/tests/Data/Cfg/BnfTests.hs +++ b/tests/Data/Cfg/BnfTests.hs @@ -1,29 +1,33 @@ {-# LANGUAGE QuasiQuotes #-} -module Data.Cfg.BnfTests(tests) where +module Data.Cfg.BnfTests + ( tests + ) where + import Data.Cfg.Bnf import Data.Cfg.Cfg import Data.Cfg.FreeCfg import qualified Data.Set as S -import Test.Framework(Test, testGroup) -import Test.Framework.Providers.HUnit(testCase) -import Test.HUnit(assertEqual) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (assertEqual) tests :: Test -tests = testGroup "Data.Cfg.Bnf" [ test ] +tests = testGroup "Data.Cfg.Bnf" [test] test :: Test -test = testCase "bnf quasiquoter sanity test" $ do +test = + testCase "bnf quasiquoter sanity test" $ do assertEqual "startSymbol works" "foo" (startSymbol cfg') assertEqual "terminals works" 5 (S.size $ terminals cfg') assertEqual "nonterminals works" 2 (S.size $ nonterminals cfg') assertEqual "productions count works" 3 (length $ productions cfg') - where + where cfg' = toFreeCfg gram' - gram' = [bnf|foo ::= A B C D bar. - foo ::= . - bar ::= E A B. |] - + gram' = + [bnf|foo ::= A B C D bar. + foo ::= . + bar ::= E A B. |] {- Test code for yieldCfg. import Data.Cfg.RuleApplication @@ -33,6 +37,6 @@ y = yieldCfg cfg cfg = gramToCfg' gram' gram' = [gram|digits ::= digit | digit digits . - digit ::= O | I . |] + digit ::= O | I . |] -} diff --git a/tests/Data/Cfg/FirstSetTests.hs b/tests/Data/Cfg/FirstSetTests.hs --- a/tests/Data/Cfg/FirstSetTests.hs +++ b/tests/Data/Cfg/FirstSetTests.hs @@ -1,62 +1,55 @@ -module Data.Cfg.FirstSetTests ( - tests - ) where +module Data.Cfg.FirstSetTests + ( tests + ) where import Data.Cfg.Analysis import Data.Cfg.Augment import Data.Cfg.LookaheadSet import Data.Cfg.TestGrammars -import Test.Framework(Test, testGroup) -import Test.Framework.Providers.HUnit(testCase) -import Test.HUnit(assertEqual) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (assertEqual) tests :: Test -tests = testGroup "Data.Cfg.FirstSet" [ - g0FirstSetTest, - microFirstSetTest - ] +tests = testGroup "Data.Cfg.FirstSet" [g0FirstSetTest, microFirstSetTest] g0FirstSetTest :: Test g0FirstSetTest = testCase "g0 first-set test" $ mapM_ f tab - where + where f :: (String, LookaheadSet String) -> IO () f (nt, expected) = assertEqual msg expected (fs $ AugNT nt) - where - msg = "g0: firstSet(" ++ nt ++ ")" - + where + msg = "g0: firstSet(" ++ nt ++ ")" tab :: [(String, LookaheadSet String)] - tab = [("e", mkLookaheadSet False $ words "F LPAREN V"), - ("prefix", mkLookaheadSet True ["F"]), - ("tail", mkLookaheadSet True ["PLUS"])] - + tab = + [ ("e", mkLookaheadSet False $ words "F LPAREN V") + , ("prefix", mkLookaheadSet True ["F"]) + , ("tail", mkLookaheadSet True ["PLUS"]) + ] fs :: AugNT String -> LookaheadSet String fs = firstSet g0Analysis microFirstSetTest :: Test microFirstSetTest = testCase "micro first-set test" $ mapM_ f tab - where + where f :: (String, LookaheadSet String) -> IO () f (nt, expected) = assertEqual msg expected (fs $ AugNT nt) - where - msg = "micro: firstSet(" ++ nt ++ ")" - + where + msg = "micro: firstSet(" ++ nt ++ ")" tab :: [(String, LookaheadSet String)] - tab = [ - ("program", mkLookaheadSet False $ words "BEGIN"), - ("statement_list", mkLookaheadSet False $ words "ID READ WRITE"), - ("statement", mkLookaheadSet False $ words "ID READ WRITE"), - ("statement_tail", mkLookaheadSet True $ words "ID READ WRITE"), - ("expression", - mkLookaheadSet False $ words "ID INT_LITERAL LPAREN"), - ("id_list", mkLookaheadSet False $ words "ID"), - ("expr_list", - mkLookaheadSet False $ words "ID INT_LITERAL LPAREN"), - ("id_tail", mkLookaheadSet True $ words "COMMA"), - ("expr_tail", mkLookaheadSet True $ words "COMMA"), - ("primary", mkLookaheadSet False $ words "ID INT_LITERAL LPAREN"), - ("primary_tail", mkLookaheadSet True $ words "PLUS MINUS"), - ("add_op", mkLookaheadSet False $ words "PLUS MINUS") ] - + tab = + [ ("program", mkLookaheadSet False $ words "BEGIN") + , ("statement_list", mkLookaheadSet False $ words "ID READ WRITE") + , ("statement", mkLookaheadSet False $ words "ID READ WRITE") + , ("statement_tail", mkLookaheadSet True $ words "ID READ WRITE") + , ("expression", mkLookaheadSet False $ words "ID INT_LITERAL LPAREN") + , ("id_list", mkLookaheadSet False $ words "ID") + , ("expr_list", mkLookaheadSet False $ words "ID INT_LITERAL LPAREN") + , ("id_tail", mkLookaheadSet True $ words "COMMA") + , ("expr_tail", mkLookaheadSet True $ words "COMMA") + , ("primary", mkLookaheadSet False $ words "ID INT_LITERAL LPAREN") + , ("primary_tail", mkLookaheadSet True $ words "PLUS MINUS") + , ("add_op", mkLookaheadSet False $ words "PLUS MINUS") + ] fs :: AugNT String -> LookaheadSet String fs = firstSet microAnalysis - diff --git a/tests/Data/Cfg/FollowSetTests.hs b/tests/Data/Cfg/FollowSetTests.hs --- a/tests/Data/Cfg/FollowSetTests.hs +++ b/tests/Data/Cfg/FollowSetTests.hs @@ -1,60 +1,55 @@ -module Data.Cfg.FollowSetTests ( - tests - ) where +module Data.Cfg.FollowSetTests + ( tests + ) where import Data.Cfg.Analysis import Data.Cfg.Augment import Data.Cfg.LookaheadSet import Data.Cfg.TestGrammars -import Test.Framework(Test, testGroup) -import Test.Framework.Providers.HUnit(testCase) -import Test.HUnit(assertEqual) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (assertEqual) tests :: Test -tests = testGroup "Data.Cfg.FollowSet" [ - g0FollowSetTest, - microFollowSetTest - ] +tests = testGroup "Data.Cfg.FollowSet" [g0FollowSetTest, microFollowSetTest] g0FollowSetTest :: Test g0FollowSetTest = testCase "g0 follow-set test" $ mapM_ f tab - where + where f :: (String, LookaheadSet String) -> IO () f (nt, expected) = assertEqual msg expected (fols $ AugNT nt) - where - msg = "g0: followSet(" ++ nt ++ ")" - + where + msg = "g0: followSet(" ++ nt ++ ")" tab :: [(String, LookaheadSet String)] - tab = [("e", mkLookaheadSet True ["RPAREN"]), - ("prefix", mkLookaheadSet False ["LPAREN"]), - ("tail", mkLookaheadSet True ["RPAREN"])] - + tab = + [ ("e", mkLookaheadSet True ["RPAREN"]) + , ("prefix", mkLookaheadSet False ["LPAREN"]) + , ("tail", mkLookaheadSet True ["RPAREN"]) + ] fols :: AugNT String -> LookaheadSet String fols = followSet g0Analysis microFollowSetTest :: Test microFollowSetTest = testCase "micro follow-set test" $ mapM_ f tab - where + where f :: (String, LookaheadSet String) -> IO () f (nt, expected) = assertEqual msg expected (fols $ AugNT nt) - where - msg = "micro: followSet(" ++ nt ++ ")" - + where + msg = "micro: followSet(" ++ nt ++ ")" tab :: [(String, LookaheadSet String)] - tab = [ ("program", mkLookaheadSet True []), - ("statement_list", mkLookaheadSet False $ words "END"), - ("statement", mkLookaheadSet False $ words "ID READ WRITE END"), - ("statement_tail", mkLookaheadSet False $ words "END"), - ("expression", mkLookaheadSet False $ words "COMMA SEMI RPAREN"), - ("id_list", mkLookaheadSet False $ words "RPAREN"), - ("expr_list", mkLookaheadSet False $ words "RPAREN"), - ("id_tail", mkLookaheadSet False $ words "RPAREN"), - ("expr_tail", mkLookaheadSet False $ words "RPAREN"), - ("primary", - mkLookaheadSet False $ words "COMMA SEMI PLUS MINUS RPAREN"), - ("primary_tail", mkLookaheadSet False $ words "COMMA SEMI RPAREN"), - ("add_op", mkLookaheadSet False $ words "ID INT_LITERAL LPAREN") ] - + tab = + [ ("program", mkLookaheadSet True []) + , ("statement_list", mkLookaheadSet False $ words "END") + , ("statement", mkLookaheadSet False $ words "ID READ WRITE END") + , ("statement_tail", mkLookaheadSet False $ words "END") + , ("expression", mkLookaheadSet False $ words "COMMA SEMI RPAREN") + , ("id_list", mkLookaheadSet False $ words "RPAREN") + , ("expr_list", mkLookaheadSet False $ words "RPAREN") + , ("id_tail", mkLookaheadSet False $ words "RPAREN") + , ("expr_tail", mkLookaheadSet False $ words "RPAREN") + , ("primary", mkLookaheadSet False $ words "COMMA SEMI PLUS MINUS RPAREN") + , ("primary_tail", mkLookaheadSet False $ words "COMMA SEMI RPAREN") + , ("add_op", mkLookaheadSet False $ words "ID INT_LITERAL LPAREN") + ] fols :: AugNT String -> LookaheadSet String fols = followSet microAnalysis - diff --git a/tests/Data/Cfg/LookaheadSetTests.hs b/tests/Data/Cfg/LookaheadSetTests.hs --- a/tests/Data/Cfg/LookaheadSetTests.hs +++ b/tests/Data/Cfg/LookaheadSetTests.hs @@ -1,21 +1,24 @@ {-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Data.Cfg.LookaheadSetTests ( - tests - ) where -import Control.Monad(liftM2) -import Data.Cfg.LookaheadSet(LookaheadSet, mkLookaheadSet) -import Test.Framework(Test, testGroup) -import Test.Framework.Providers.QuickCheck2(testProperty) -import Test.QuickCheck(Arbitrary(..), listOf) -import Test.QuickCheck.Property.Monoid(T(..), eq, prop_Monoid) +module Data.Cfg.LookaheadSetTests + ( tests + ) where +import Control.Monad (liftM2) +import Data.Cfg.LookaheadSet (LookaheadSet, mkLookaheadSet) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.QuickCheck (Arbitrary(..), listOf) +import Test.QuickCheck.Property.Monoid (T(..), eq, prop_Monoid) + instance Arbitrary (LookaheadSet Int) where - arbitrary = liftM2 mkLookaheadSet arbitrary $ listOf arbitrary + arbitrary = liftM2 mkLookaheadSet arbitrary $ listOf arbitrary tests :: Test -tests = testGroup "Data.Cfg.Lookahead" [ - testProperty "monoid laws for lookahead sets" - $ eq $ prop_Monoid (T :: T (LookaheadSet Int)) +tests = + testGroup + "Data.Cfg.Lookahead" + [ testProperty "monoid laws for lookahead sets" $ + eq $ prop_Monoid (T :: T (LookaheadSet Int)) ] diff --git a/tests/Data/Cfg/ProductiveTests.hs b/tests/Data/Cfg/ProductiveTests.hs --- a/tests/Data/Cfg/ProductiveTests.hs +++ b/tests/Data/Cfg/ProductiveTests.hs @@ -1,53 +1,55 @@ {-# LANGUAGE QuasiQuotes #-} -module Data.Cfg.ProductiveTests ( - tests - ) where -import Data.Cfg.Bnf(Grammar(..), bnf) -import Data.Cfg.Cfg(Cfg(..), V(..)) -import Data.Cfg.FreeCfg(FreeCfg(..), toFreeCfg) +module Data.Cfg.ProductiveTests + ( tests + ) where + +import Data.Cfg.Bnf (Grammar(..), bnf) +import Data.Cfg.Cfg (Cfg(..), V(..)) +import Data.Cfg.FreeCfg (FreeCfg(..), toFreeCfg) import Data.Cfg.Productive -import Data.Cfg.TestGrammars(assertEqCfg, wiki) +import Data.Cfg.TestGrammars (assertEqCfg, wiki) import qualified Data.Set as S -import Test.Framework(Test, testGroup) -import Test.Framework.Providers.HUnit(testCase) -import Test.HUnit(assertEqual) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (assertEqual) import Text.PrettyPrint tests :: Test -tests = testGroup "Data.Cfg.Productive" [ - wikiTest - ] +tests = testGroup "Data.Cfg.Productive" [wikiTest] wikiTest :: Test -wikiTest = testCase "wiki productivity test" $ do - assertEqual "productives" (S.fromList $ grammarProductions prods') - (productives wiki) - assertEqual "unproductives" (S.fromList $ grammarProductions unprods') - (unproductives wiki) +wikiTest = + testCase "wiki productivity test" $ do + assertEqual + "productives" + (S.fromList $ grammarProductions prods') + (productives wiki) + assertEqual + "unproductives" + (S.fromList $ grammarProductions unprods') + (unproductives wiki) assertEqCfg ctxt ctxt "productivity" expected $ removeUnproductives wiki - - where + where ctxt :: V String String -> Doc - ctxt v = text $ case v of - NT nt -> nt - T t -> t - + ctxt v = + text $ + case v of + NT nt -> nt + T t -> t expected :: FreeCfg String String - expected = (toFreeCfg prods') { - terminals' = terminals wiki - } - + expected = (toFreeCfg prods') {terminals' = terminals wiki} prods' :: Grammar String String - prods' = [bnf| - s ::= b B | c C. - b ::= b B | B. - c ::= c C | C. - d ::= b D | c D | D. + prods' = + [bnf| + s ::= b B | c C. + b ::= b B | B. + c ::= c C | C. + d ::= b D | c D | D. |] - unprods' :: Grammar String String - unprods' = [bnf| + unprods' = + [bnf| s ::= e E. e ::= e E. |] diff --git a/tests/Data/Cfg/ReachableTests.hs b/tests/Data/Cfg/ReachableTests.hs --- a/tests/Data/Cfg/ReachableTests.hs +++ b/tests/Data/Cfg/ReachableTests.hs @@ -1,45 +1,42 @@ {-# LANGUAGE QuasiQuotes #-} -module Data.Cfg.ReachableTests ( - tests - ) where -import Data.Cfg.Bnf(bnf) -import Data.Cfg.Cfg(Cfg(..), V(..)) -import Data.Cfg.FreeCfg(FreeCfg(..), toFreeCfg) +module Data.Cfg.ReachableTests + ( tests + ) where + +import Data.Cfg.Bnf (bnf) +import Data.Cfg.Cfg (Cfg(..), V(..)) +import Data.Cfg.FreeCfg (FreeCfg(..), toFreeCfg) import Data.Cfg.Reachable -import Data.Cfg.TestGrammars(assertEqCfg, wiki) +import Data.Cfg.TestGrammars (assertEqCfg, wiki) import qualified Data.Set as S -import Test.Framework(Test, testGroup) -import Test.Framework.Providers.HUnit(testCase) -import Test.HUnit(assertEqual) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (assertEqual) import Text.PrettyPrint tests :: Test -tests = testGroup "Data.Cfg.Reachable" [ - wikiTest - ] +tests = testGroup "Data.Cfg.Reachable" [wikiTest] wikiTest :: Test -wikiTest = testCase "wiki reachability test" $ do - assertEqual "reachables" (S.fromList $ words "s b c e") - (reachables wiki) - assertEqual "unreachables" (S.fromList $ words "d") - (unreachables wiki) +wikiTest = + testCase "wiki reachability test" $ do + assertEqual "reachables" (S.fromList $ words "s b c e") (reachables wiki) + assertEqual "unreachables" (S.fromList $ words "d") (unreachables wiki) assertEqCfg ctxt ctxt "reachability" expected $ removeUnreachables wiki - - where + where ctxt :: V String String -> Doc - ctxt v = text $ case v of - NT nt -> nt - T t -> t - reach = [bnf| - s ::= b B | c C | e E. - b ::= b B | B. - c ::= c C | C. - e ::= e E. - |] - + ctxt v = + text $ + case v of + NT nt -> nt + T t -> t + reach = + [bnf| + s ::= b B | c C | e E. + b ::= b B | B. + c ::= c C | C. + e ::= e E. + |] expected :: FreeCfg String String - expected = (toFreeCfg reach){ - terminals' = terminals wiki - } + expected = (toFreeCfg reach) {terminals' = terminals wiki} diff --git a/tests/Data/Cfg/TestGrammars.hs b/tests/Data/Cfg/TestGrammars.hs --- a/tests/Data/Cfg/TestGrammars.hs +++ b/tests/Data/Cfg/TestGrammars.hs @@ -1,57 +1,74 @@ -- | Sample grammars for tests {-# LANGUAGE QuasiQuotes #-} -module Data.Cfg.TestGrammars ( + +module Data.Cfg.TestGrammars -- * Assertion for equality in 'Cfg' - assertEqCfg, + ( assertEqCfg -- * Grammars for sanity checks - g0, - micro, - wiki, + , g0 + , micro + , wiki -- * Analysis of grammars for sanity checks - g0Analysis, - microAnalysis, - wikiAnalysis, + , g0Analysis + , microAnalysis + , wikiAnalysis -- * Convenience functions for the REPL - pretty' - ) where + , pretty' + ) where import Data.Cfg.Analysis import Data.Cfg.Augment import Data.Cfg.Bnf -import Data.Cfg.Cfg(Cfg(..), V(..), eqCfg) import Data.Cfg.CPretty +import Data.Cfg.Cfg (Cfg(..), V(..), eqCfg) + +import Test.HUnit (assertBool) -- import Data.Cfg.FreeCfg import Text.PrettyPrint -import Test.HUnit(assertBool) -- | An assertion for testing equality of 'Cfg'. -assertEqCfg :: (Cfg cfg t nt, CPretty (cfg t nt) ctxt, - Cfg cfg' t nt, CPretty (cfg' t nt) ctxt', - Eq t, Eq nt) - => ctxt -> ctxt' -> String -> cfg t nt -> cfg' t nt -> IO () +assertEqCfg :: + ( Cfg cfg t nt + , CPretty (cfg t nt) ctxt + , Cfg cfg' t nt + , CPretty (cfg' t nt) ctxt' + , Eq t + , Eq nt + ) + => ctxt + -> ctxt' + -> String + -> cfg t nt + -> cfg' t nt + -> IO () assertEqCfg ctxt ctxt' msg expected actual = - assertBool msg' (eqCfg expected actual) - where + assertBool msg' (eqCfg expected actual) + where msg' = show $ vcat [text msg, expected', actual'] expected' = text "Expected:" <+> cpretty expected ctxt actual' = text "Actual:" <+> cpretty actual ctxt' pretty' :: AugFreeCfg String String -> Doc pretty' cfg = cpretty cfg ctxt - where + where ctxt :: AugV String String -> Doc - ctxt v = text $ case v of - NT nt -> case nt of - StartSymbol -> "$start" - AugNT s -> s - T t -> case t of - EOF -> "$EOF" - AugT s -> s + ctxt v = + text $ + case v of + NT nt -> + case nt of + StartSymbol -> "$start" + AugNT s -> s + T t -> + case t of + EOF -> "$EOF" + AugT s -> s -- | A test grammar. Found in Crafting a compiler, by Charles -- N. Fischer and Richard J. LeBlanc, Jr., (c) 1998, pg. 95. g0 :: Grammar String String -g0 = [bnf| +g0 = + [bnf| e ::= prefix LPAREN e RPAREN. e ::= V tail. prefix ::= F. @@ -62,7 +79,8 @@ -- | A test grammar. Found in Fischer and LeBlanc, pg. 111. micro :: Grammar String String -micro = [bnf| +micro = + [bnf| program ::= BEGIN statement_list END. statement_list ::= statement statement_tail. statement_tail ::= statement statement_tail. @@ -89,7 +107,8 @@ -- | A test grammar. Found at -- http://en.wikipedia.org/wiki/Useless_rules; retrieved 2015-03-14. wiki :: Grammar String String -wiki = [bnf| +wiki = + [bnf| s ::= b B | c C | e E. b ::= b B | B. c ::= c C | C. diff --git a/tests/Data/CfgTests.hs b/tests/Data/CfgTests.hs --- a/tests/Data/CfgTests.hs +++ b/tests/Data/CfgTests.hs @@ -1,79 +1,86 @@ {-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Data.CfgTests (sampleCfg, tests) where -import Control.Monad(forM) -import Data.Char(toLower, toUpper) +module Data.CfgTests + ( sampleCfg + , tests + ) where + +import Control.Monad (forM) import qualified Data.Cfg.BnfTests -import Data.Cfg.Cfg(V(..)) -import Data.Cfg.CPretty(cpretty) -import Data.Cfg.FreeCfg +import Data.Cfg.CPretty (cpretty) +import Data.Cfg.Cfg (V(..)) import qualified Data.Cfg.FirstSetTests import qualified Data.Cfg.FollowSetTests +import Data.Cfg.FreeCfg import qualified Data.Cfg.LookaheadSetTests import qualified Data.Cfg.ProductiveTests import qualified Data.Cfg.ReachableTests +import Data.Char (toLower, toUpper) import qualified Data.Map as M import qualified Data.Set as S -import Test.Framework(Test, testGroup) +import Test.Framework (Test, testGroup) import Test.QuickCheck import Text.PrettyPrint instance Arbitrary (FreeCfg Int Int) where - arbitrary = do - tCnt <- choose (1, 25) - let ts = [0..tCnt-1] - ntCnt <- choose (1, 100) - let nts = [0..ntCnt-1] - let vs = map T ts ++ map NT nts - let genV = elements vs - let genVs = listOf genV - pairs <- forM nts $ \nt -> do - altCnt <- choose (1, 5) - rhss <- vectorOf altCnt genVs - return (nt, S.fromList rhss) - - let map' = M.fromList pairs - return FreeCfg { - nonterminals' = S.fromList nts, - terminals' = S.fromList ts, - productionRules' = (map' M.!), - startSymbol' = 0 - } + arbitrary = do + tCnt <- choose (1, 25) + let ts = [0 .. tCnt - 1] + ntCnt <- choose (1, 100) + let nts = [0 .. ntCnt - 1] + let vs = map T ts ++ map NT nts + let genV = elements vs + let genVs = listOf genV + pairs <- + forM nts $ \nt -> do + altCnt <- choose (1, 5) + rhss <- vectorOf altCnt genVs + return (nt, S.fromList rhss) + let map' = M.fromList pairs + return + FreeCfg + { nonterminals' = S.fromList nts + , terminals' = S.fromList ts + , productionRules' = (map' M.!) + , startSymbol' = 0 + } ctxt :: V Int Int -> Doc ctxt v = text $ map f $ base26 n - where - (f, n) = case v of - NT n' -> (toLower, n') - T n' -> (toUpper, n') - + where + (f, n) = + case v of + NT n' -> (toLower, n') + T n' -> (toUpper, n') base26 :: Int -> String base26 n' - | n' < 26 = [digitToChar n'] - | otherwise = if msds == 0 - then [digitToChar lsd] - else base26 msds ++ [digitToChar lsd] - where - (msds, lsd) = n' `divMod` 26 - - digitToChar :: Int -> Char - digitToChar digit = toEnum (fromEnum 'a' + digit) + | n' < 26 = [digitToChar n'] + | otherwise = + if msds == 0 + then [digitToChar lsd] + else base26 msds ++ [digitToChar lsd] + where + (msds, lsd) = n' `divMod` 26 + digitToChar :: Int -> Char + digitToChar digit = toEnum (fromEnum 'a' + digit) pretty :: FreeCfg Int Int -> Doc pretty cfg = cpretty cfg ctxt sampleCfg :: IO () sampleCfg = do - cfgs <- sample' (arbitrary :: Gen (FreeCfg Int Int)) - mapM_ (print . pretty) (take 3 cfgs) + cfgs <- sample' (arbitrary :: Gen (FreeCfg Int Int)) + mapM_ (print . pretty) (take 3 cfgs) tests :: Test -tests = testGroup "Data.Cfg" [ - Data.Cfg.BnfTests.tests, - Data.Cfg.FirstSetTests.tests, - Data.Cfg.FollowSetTests.tests, - Data.Cfg.LookaheadSetTests.tests, - Data.Cfg.ProductiveTests.tests, - Data.Cfg.ReachableTests.tests +tests = + testGroup + "Data.Cfg" + [ Data.Cfg.BnfTests.tests + , Data.Cfg.FirstSetTests.tests + , Data.Cfg.FollowSetTests.tests + , Data.Cfg.LookaheadSetTests.tests + , Data.Cfg.ProductiveTests.tests + , Data.Cfg.ReachableTests.tests ] diff --git a/tests/Test.hs b/tests/Test.hs --- a/tests/Test.hs +++ b/tests/Test.hs @@ -1,9 +1,7 @@ module Main where -import Data.CfgTests(tests) -import Test.Framework(defaultMain) +import Data.CfgTests (tests) +import Test.Framework (defaultMain) main :: IO () main = defaultMain [tests] - -