diff --git a/BNFC.cabal b/BNFC.cabal --- a/BNFC.cabal +++ b/BNFC.cabal @@ -1,10 +1,10 @@ Name: BNFC -Version: 2.7.0.0 +Version: 2.7.0.1 cabal-version: >= 1.8 build-type: Simple category: Development Copyright: (c) Krasimir Angelov, Jean-Philippe Bernardy, Bjorn Bringert, Johan Broberg, Paul Callaghan, Markus Forsberg, Ola Frid, Peter Gammie, Patrik Jansson, Kristofer Johannisson, Antti-Juhani Kaijanaho, Ulf Norell, Michael Pellauer and Aarne Ranta 2002 - 2012. Free software under GNU General Public License (GPL). -License: GPL +License: GPL-2 License-File: LICENSE Maintainer: bnfc-dev@googlegroups.com Homepage: http://bnfc.digitalgrammars.com/ @@ -23,6 +23,11 @@ a pretty-printer as a Haskell/Java/C++/C module, a Latex file containing a readable specification of the language. Extra-source-files: src/BNF.cf TODO + +Source-repository head + type: git + location: https://github.com/BNFC/bnfc.git + subdir: source Library hs-source-dirs: runtime, src diff --git a/dist/build/bnfc/bnfc-tmp/LexBNF.hs b/dist/build/bnfc/bnfc-tmp/LexBNF.hs --- a/dist/build/bnfc/bnfc-tmp/LexBNF.hs +++ b/dist/build/bnfc/bnfc-tmp/LexBNF.hs @@ -40,7 +40,7 @@ alex_deflt :: AlexAddr alex_deflt = AlexA# "\xff\xff\x06\x00\x06\x00\xff\xff\xff\xff\xff\xff\x06\x00\xff\xff\xff\xff\x06\x00\x06\x00\x13\x00\x13\x00\x04\x00\x04\x00\xff\xff\x18\x00\xff\xff\x18\x00\x1c\x00\x1c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x06\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"# -alex_accept = listArray (0::Int,42) [[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_8))]] +alex_accept = listArray (0::Int,42) [AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccSkip,AlexAccSkip,AlexAccSkip,AlexAccSkip,AlexAcc (alex_action_3),AlexAcc (alex_action_3),AlexAcc (alex_action_3),AlexAcc (alex_action_3),AlexAcc (alex_action_4),AlexAcc (alex_action_5),AlexAcc (alex_action_6),AlexAcc (alex_action_7),AlexAcc (alex_action_8),AlexAcc (alex_action_8)] {-# LINE 38 "src/LexBNF.x" #-} @@ -183,6 +183,7 @@ alex_action_8 = tok (\p s -> PT p (TD $ share s)) {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} +{-# LINE 1 "" #-} {-# LINE 1 "" #-} @@ -190,6 +191,7 @@ + # 1 "/usr/include/stdc-predef.h" 1 3 4 # 17 "/usr/include/stdc-predef.h" 3 4 @@ -216,7 +218,7 @@ -# 6 "" 2 +{-# LINE 7 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- -- ALEX TEMPLATE @@ -227,13 +229,25 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 37 "templates/GenericTemplate.hs" #-} +{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 47 "templates/GenericTemplate.hs" #-} -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__ > 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 +{-# LINE 51 "templates/GenericTemplate.hs" #-} + + +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 @@ -260,14 +274,14 @@ #ifdef WORDS_BIGENDIAN narrow32Int# i where - !i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` + 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# + 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 @@ -276,6 +290,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -342,35 +357,29 @@ - let - (base) = alexIndexInt32OffAddr alex_base s - ((I# (ord_c))) = fromIntegral c - (offset) = (base +# ord_c) - (check) = alexIndexInt16OffAddr alex_check offset + 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 (offset >=# 0#) && (check ==# ord_c) + 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 + 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 [] = last_acc - check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len)) - check_accs (AlexAccPred a predx : rest) - | predx user orig_input (I# (len)) input - = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkipPred predx : rest) - | predx user orig_input (I# (len)) input - = AlexLastSkip input (I# (len)) - check_accs (_ : rest) = check_accs rest + check_accs (AlexAccNone) = last_acc + check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) + check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -383,35 +392,10 @@ fmap f (AlexLastSkip x y) = AlexLastSkip x y data AlexAcc a user - = AlexAcc a + = AlexAccNone + | AlexAcc a | AlexAccSkip - | AlexAccPred a (AlexAccPred user) - | AlexAccSkipPred (AlexAccPred user) - -type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool - --- ----------------------------------------------------------------------------- --- Predicates on a rule - -alexAndPred p1 p2 user in1 len in2 - = p1 user in1 len in2 && p2 user in1 len in2 - ---alexPrevCharIsPred :: Char -> AlexAccPred _ -alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input - -alexPrevCharMatches f _ input _ _ = f (alexInputPrevChar input) - ---alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ -alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input - ---alexRightContext :: Int -> AlexAccPred _ -alexRightContext (I# (sc)) user _ _ input = - case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, _) -> False - _ -> True - -- TODO: there's no need to find the longest - -- match when checking the right context, just - -- the first match will do. +{-# LINE 242 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i diff --git a/dist/build/bnfc/bnfc-tmp/ParBNF.hs b/dist/build/bnfc/bnfc-tmp/ParBNF.hs --- a/dist/build/bnfc/bnfc-tmp/ParBNF.hs +++ b/dist/build/bnfc/bnfc-tmp/ParBNF.hs @@ -7,8 +7,9 @@ import ErrM 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.18.10 +-- parser produced by Happy Version 1.19.4 newtype HappyAbsSyn = HappyAbsSyn HappyAny #if __GLASGOW_HASKELL__ >= 607 @@ -1449,6 +1450,7 @@ myLexer = tokens {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} +{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 8 "" #-} # 1 "/usr/include/stdc-predef.h" 1 3 4 @@ -1477,24 +1479,40 @@ -# 8 "" 2 +{-# LINE 8 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp -{-# LINE 30 "templates/GenericTemplate.hs" #-} +{-# LINE 13 "templates/GenericTemplate.hs" #-} + + + +-- 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 +{-# LINE 46 "templates/GenericTemplate.hs" #-} + + data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList -{-# LINE 51 "templates/GenericTemplate.hs" #-} +{-# LINE 67 "templates/GenericTemplate.hs" #-} -{-# LINE 61 "templates/GenericTemplate.hs" #-} +{-# LINE 77 "templates/GenericTemplate.hs" #-} -{-# LINE 70 "templates/GenericTemplate.hs" #-} +{-# LINE 86 "templates/GenericTemplate.hs" #-} infixr 9 `HappyStk` data HappyStk a = HappyStk a (HappyStk a) @@ -1511,9 +1529,9 @@ -- 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 + happyReturn1 ans happyAccept j tk st sts (HappyStk ans _) = - (happyTcHack j (happyTcHack st)) (happyReturn1 ans) + (happyTcHack j (happyTcHack st)) (happyReturn1 ans) ----------------------------------------------------------------------------- -- Arrays only: do the next action @@ -1521,37 +1539,35 @@ happyDoAction i tk st - = {- nothing -} + = {- nothing -} - case action of - 0# -> {- nothing -} - happyFail i tk st - -1# -> {- nothing -} - happyAccept i tk st - n | (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#)) -> {- 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 -} + (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 (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#)) - then (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==# i) - else False - (action) + 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 -{-# LINE 130 "templates/GenericTemplate.hs" #-} - indexShortOffAddr (HappyA# arr) off = - Happy_GHC_Exts.narrow16Int# i + 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#))) @@ -1570,13 +1586,13 @@ ----------------------------------------------------------------------------- -- HappyState data type (not arrays) -{-# LINE 163 "templates/GenericTemplate.hs" #-} +{-# LINE 170 "templates/GenericTemplate.hs" #-} ----------------------------------------------------------------------------- -- 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 + 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) @@ -1612,30 +1628,33 @@ = 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) + 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 = - happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) - where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k 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 = - happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) - where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k 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 + 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 @@ -1650,9 +1669,9 @@ 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 + where off = indexShortOffAddr happyGotoOffsets st + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i @@ -1662,8 +1681,8 @@ -- 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" $ + 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 @@ -1672,16 +1691,16 @@ -- 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)) + (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) + happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) -- Internal happy errors: @@ -1699,9 +1718,9 @@ ----------------------------------------------------------------------------- -- Seq-ing. If the --strict flag is given, then Happy emits --- happySeq = happyDoSeq +-- happySeq = happyDoSeq -- otherwise it emits --- happySeq = happyDontSeq +-- happySeq = happyDontSeq happyDoSeq, happyDontSeq :: a -> b -> b happyDoSeq a b = a `seq` b diff --git a/dist/build/unit-tests/unit-tests-tmp/LexBNF.hs b/dist/build/unit-tests/unit-tests-tmp/LexBNF.hs --- a/dist/build/unit-tests/unit-tests-tmp/LexBNF.hs +++ b/dist/build/unit-tests/unit-tests-tmp/LexBNF.hs @@ -40,7 +40,7 @@ alex_deflt :: AlexAddr alex_deflt = AlexA# "\xff\xff\x06\x00\x06\x00\xff\xff\xff\xff\xff\xff\x06\x00\xff\xff\xff\xff\x06\x00\x06\x00\x13\x00\x13\x00\x04\x00\x04\x00\xff\xff\x18\x00\xff\xff\x18\x00\x1c\x00\x1c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x06\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"# -alex_accept = listArray (0::Int,42) [[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_8))]] +alex_accept = listArray (0::Int,42) [AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccSkip,AlexAccSkip,AlexAccSkip,AlexAccSkip,AlexAcc (alex_action_3),AlexAcc (alex_action_3),AlexAcc (alex_action_3),AlexAcc (alex_action_3),AlexAcc (alex_action_4),AlexAcc (alex_action_5),AlexAcc (alex_action_6),AlexAcc (alex_action_7),AlexAcc (alex_action_8),AlexAcc (alex_action_8)] {-# LINE 38 "src/LexBNF.x" #-} @@ -183,6 +183,7 @@ alex_action_8 = tok (\p s -> PT p (TD $ share s)) {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} +{-# LINE 1 "" #-} {-# LINE 1 "" #-} @@ -190,6 +191,7 @@ + # 1 "/usr/include/stdc-predef.h" 1 3 4 # 17 "/usr/include/stdc-predef.h" 3 4 @@ -216,7 +218,7 @@ -# 6 "" 2 +{-# LINE 7 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- -- ALEX TEMPLATE @@ -227,13 +229,25 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 37 "templates/GenericTemplate.hs" #-} +{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 47 "templates/GenericTemplate.hs" #-} -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__ > 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 +{-# LINE 51 "templates/GenericTemplate.hs" #-} + + +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 @@ -260,14 +274,14 @@ #ifdef WORDS_BIGENDIAN narrow32Int# i where - !i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` + 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# + 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 @@ -276,6 +290,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -342,35 +357,29 @@ - let - (base) = alexIndexInt32OffAddr alex_base s - ((I# (ord_c))) = fromIntegral c - (offset) = (base +# ord_c) - (check) = alexIndexInt16OffAddr alex_check offset + 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 (offset >=# 0#) && (check ==# ord_c) + 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 + 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 [] = last_acc - check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len)) - check_accs (AlexAccPred a predx : rest) - | predx user orig_input (I# (len)) input - = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkipPred predx : rest) - | predx user orig_input (I# (len)) input - = AlexLastSkip input (I# (len)) - check_accs (_ : rest) = check_accs rest + check_accs (AlexAccNone) = last_acc + check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) + check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -383,35 +392,10 @@ fmap f (AlexLastSkip x y) = AlexLastSkip x y data AlexAcc a user - = AlexAcc a + = AlexAccNone + | AlexAcc a | AlexAccSkip - | AlexAccPred a (AlexAccPred user) - | AlexAccSkipPred (AlexAccPred user) - -type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool - --- ----------------------------------------------------------------------------- --- Predicates on a rule - -alexAndPred p1 p2 user in1 len in2 - = p1 user in1 len in2 && p2 user in1 len in2 - ---alexPrevCharIsPred :: Char -> AlexAccPred _ -alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input - -alexPrevCharMatches f _ input _ _ = f (alexInputPrevChar input) - ---alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ -alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input - ---alexRightContext :: Int -> AlexAccPred _ -alexRightContext (I# (sc)) user _ _ input = - case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, _) -> False - _ -> True - -- TODO: there's no need to find the longest - -- match when checking the right context, just - -- the first match will do. +{-# LINE 242 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i diff --git a/dist/build/unit-tests/unit-tests-tmp/ParBNF.hs b/dist/build/unit-tests/unit-tests-tmp/ParBNF.hs --- a/dist/build/unit-tests/unit-tests-tmp/ParBNF.hs +++ b/dist/build/unit-tests/unit-tests-tmp/ParBNF.hs @@ -7,8 +7,9 @@ import ErrM 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.18.10 +-- parser produced by Happy Version 1.19.4 newtype HappyAbsSyn = HappyAbsSyn HappyAny #if __GLASGOW_HASKELL__ >= 607 @@ -1449,6 +1450,7 @@ myLexer = tokens {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} +{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 8 "" #-} # 1 "/usr/include/stdc-predef.h" 1 3 4 @@ -1477,24 +1479,40 @@ -# 8 "" 2 +{-# LINE 8 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp -{-# LINE 30 "templates/GenericTemplate.hs" #-} +{-# LINE 13 "templates/GenericTemplate.hs" #-} + + + +-- 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 +{-# LINE 46 "templates/GenericTemplate.hs" #-} + + data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList -{-# LINE 51 "templates/GenericTemplate.hs" #-} +{-# LINE 67 "templates/GenericTemplate.hs" #-} -{-# LINE 61 "templates/GenericTemplate.hs" #-} +{-# LINE 77 "templates/GenericTemplate.hs" #-} -{-# LINE 70 "templates/GenericTemplate.hs" #-} +{-# LINE 86 "templates/GenericTemplate.hs" #-} infixr 9 `HappyStk` data HappyStk a = HappyStk a (HappyStk a) @@ -1511,9 +1529,9 @@ -- 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 + happyReturn1 ans happyAccept j tk st sts (HappyStk ans _) = - (happyTcHack j (happyTcHack st)) (happyReturn1 ans) + (happyTcHack j (happyTcHack st)) (happyReturn1 ans) ----------------------------------------------------------------------------- -- Arrays only: do the next action @@ -1521,37 +1539,35 @@ happyDoAction i tk st - = {- nothing -} + = {- nothing -} - case action of - 0# -> {- nothing -} - happyFail i tk st - -1# -> {- nothing -} - happyAccept i tk st - n | (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#)) -> {- 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 -} + (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 (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#)) - then (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==# i) - else False - (action) + 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 -{-# LINE 130 "templates/GenericTemplate.hs" #-} - indexShortOffAddr (HappyA# arr) off = - Happy_GHC_Exts.narrow16Int# i + 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#))) @@ -1570,13 +1586,13 @@ ----------------------------------------------------------------------------- -- HappyState data type (not arrays) -{-# LINE 163 "templates/GenericTemplate.hs" #-} +{-# LINE 170 "templates/GenericTemplate.hs" #-} ----------------------------------------------------------------------------- -- 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 + 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) @@ -1612,30 +1628,33 @@ = 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) + 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 = - happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) - where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k 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 = - happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) - where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k 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 + 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 @@ -1650,9 +1669,9 @@ 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 + where off = indexShortOffAddr happyGotoOffsets st + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i @@ -1662,8 +1681,8 @@ -- 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" $ + 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 @@ -1672,16 +1691,16 @@ -- 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)) + (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) + happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) -- Internal happy errors: @@ -1699,9 +1718,9 @@ ----------------------------------------------------------------------------- -- Seq-ing. If the --strict flag is given, then Happy emits --- happySeq = happyDoSeq +-- happySeq = happyDoSeq -- otherwise it emits --- happySeq = happyDontSeq +-- happySeq = happyDontSeq happyDoSeq, happyDontSeq :: a -> b -> b happyDoSeq a b = a `seq` b