-- For GHC version 7.10 or higher {-# LANGUAGE GADTs, KindSignatures, DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_GHC -fno-warn-unused-matches #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} {-# OPTIONS_GHC -fno-warn-overlapping-patterns #-} module AbsLBNF ( Tree(..) , Grammar , Def , Item , Cat , Label , LabelId , ProfItem , IntList , RHS , MinimumSize , Reg , Ident , johnMajorEq , module ComposOpLBNF ) where import Prelude ((.), (>), (&&), (==)) import Prelude ((.), (>), (&&), (==)) import qualified Prelude as P import ComposOpLBNF data Tag = Grammar_ | Def_ | Item_ | Cat_ | Label_ | LabelId_ | ProfItem_ | IntList_ | RHS_ | MinimumSize_ | Reg_ | Ident_ type Grammar = Tree 'Grammar_ type Def = Tree 'Def_ type Item = Tree 'Item_ type Cat = Tree 'Cat_ type Label = Tree 'Label_ type LabelId = Tree 'LabelId_ type ProfItem = Tree 'ProfItem_ type IntList = Tree 'IntList_ type RHS = Tree 'RHS_ type MinimumSize = Tree 'MinimumSize_ type Reg = Tree 'Reg_ type Ident = Tree 'Ident_ data Tree (a :: Tag) where MkGrammar :: [Def] -> Tree 'Grammar_ Coercions :: Ident -> P.Integer -> Tree 'Def_ Comment :: P.String -> Tree 'Def_ Comments :: P.String -> P.String -> Tree 'Def_ Entryp :: [Ident] -> Tree 'Def_ Internal :: Label -> Cat -> [Item] -> Tree 'Def_ Layout :: [P.String] -> Tree 'Def_ LayoutStop :: [P.String] -> Tree 'Def_ LayoutTop :: Tree 'Def_ PosToken :: Ident -> Reg -> Tree 'Def_ Rule :: Label -> Cat -> [Item] -> Tree 'Def_ Rules :: Ident -> [RHS] -> Tree 'Def_ Separator :: MinimumSize -> Cat -> P.String -> Tree 'Def_ Terminator :: MinimumSize -> Cat -> P.String -> Tree 'Def_ Token :: Ident -> Reg -> Tree 'Def_ NTerminal :: Cat -> Tree 'Item_ Terminal :: P.String -> Tree 'Item_ IdCat :: Ident -> Tree 'Cat_ ListCat :: Cat -> Tree 'Cat_ LabF :: LabelId -> LabelId -> Tree 'Label_ LabNoP :: LabelId -> Tree 'Label_ LabP :: LabelId -> [ProfItem] -> Tree 'Label_ LabPF :: LabelId -> LabelId -> [ProfItem] -> Tree 'Label_ Id :: Ident -> Tree 'LabelId_ ListCons :: Tree 'LabelId_ ListE :: Tree 'LabelId_ ListOne :: Tree 'LabelId_ Wild :: Tree 'LabelId_ ProfIt :: [IntList] -> [P.Integer] -> Tree 'ProfItem_ Ints :: [P.Integer] -> Tree 'IntList_ MkRHS :: [Item] -> Tree 'RHS_ MEmpty :: Tree 'MinimumSize_ MNonempty :: Tree 'MinimumSize_ RAlt :: Reg -> Reg -> Tree 'Reg_ RAlts :: P.String -> Tree 'Reg_ RAny :: Tree 'Reg_ RChar :: P.Char -> Tree 'Reg_ RDigit :: Tree 'Reg_ REps :: Tree 'Reg_ RLetter :: Tree 'Reg_ RLower :: Tree 'Reg_ RMinus :: Reg -> Reg -> Tree 'Reg_ ROpt :: Reg -> Tree 'Reg_ RPlus :: Reg -> Tree 'Reg_ RSeq :: Reg -> Reg -> Tree 'Reg_ RSeqs :: P.String -> Tree 'Reg_ RStar :: Reg -> Tree 'Reg_ RUpper :: Tree 'Reg_ Ident ::P.String -> Tree 'Ident_ instance Compos Tree where compos r a f = \case MkGrammar defs -> r MkGrammar `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) defs Coercions x n -> r Coercions `a` f x `a` r n Entryp idents -> r Entryp `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents Internal label cat items -> r Internal `a` f label `a` f cat `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) items PosToken x reg -> r PosToken `a` f x `a` f reg Rule label cat items -> r Rule `a` f label `a` f cat `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) items Rules x rHSs -> r Rules `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) rHSs Separator minimumSize cat str -> r Separator `a` f minimumSize `a` f cat `a` r str Terminator minimumSize cat str -> r Terminator `a` f minimumSize `a` f cat `a` r str Token x reg -> r Token `a` f x `a` f reg NTerminal cat -> r NTerminal `a` f cat IdCat x -> r IdCat `a` f x ListCat cat -> r ListCat `a` f cat LabF labelId1 labelId2 -> r LabF `a` f labelId1 `a` f labelId2 LabNoP labelId -> r LabNoP `a` f labelId LabP labelId profItems -> r LabP `a` f labelId `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) profItems LabPF labelId1 labelId2 profItems -> r LabPF `a` f labelId1 `a` f labelId2 `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) profItems Id x -> r Id `a` f x ProfIt intLists integers -> r ProfIt `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) intLists `a` r integers MkRHS items -> r MkRHS `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) items RAlt reg1 reg2 -> r RAlt `a` f reg1 `a` f reg2 RMinus reg1 reg2 -> r RMinus `a` f reg1 `a` f reg2 ROpt reg -> r ROpt `a` f reg RPlus reg -> r RPlus `a` f reg RSeq reg1 reg2 -> r RSeq `a` f reg1 `a` f reg2 RStar reg -> r RStar `a` f reg t -> r t instance P.Show (Tree c) where showsPrec n = \case Ident str -> opar . P.showString "Ident" . P.showChar ' ' . P.showsPrec 1 str . cpar MkGrammar defs -> opar . P.showString "MkGrammar" . P.showChar ' ' . P.showsPrec 1 defs . cpar Coercions x n -> opar . P.showString "Coercions" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 n . cpar Comment str -> opar . P.showString "Comment" . P.showChar ' ' . P.showsPrec 1 str . cpar Comments str1 str2 -> opar . P.showString "Comments" . P.showChar ' ' . P.showsPrec 1 str1 . P.showChar ' ' . P.showsPrec 1 str2 . cpar Entryp idents -> opar . P.showString "Entryp" . P.showChar ' ' . P.showsPrec 1 idents . cpar Internal label cat items -> opar . P.showString "Internal" . P.showChar ' ' . P.showsPrec 1 label . P.showChar ' ' . P.showsPrec 1 cat . P.showChar ' ' . P.showsPrec 1 items . cpar Layout strings -> opar . P.showString "Layout" . P.showChar ' ' . P.showsPrec 1 strings . cpar LayoutStop strings -> opar . P.showString "LayoutStop" . P.showChar ' ' . P.showsPrec 1 strings . cpar LayoutTop -> P.showString "LayoutTop" PosToken x reg -> opar . P.showString "PosToken" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 reg . cpar Rule label cat items -> opar . P.showString "Rule" . P.showChar ' ' . P.showsPrec 1 label . P.showChar ' ' . P.showsPrec 1 cat . P.showChar ' ' . P.showsPrec 1 items . cpar Rules x rHSs -> opar . P.showString "Rules" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 rHSs . cpar Separator minimumSize cat str -> opar . P.showString "Separator" . P.showChar ' ' . P.showsPrec 1 minimumSize . P.showChar ' ' . P.showsPrec 1 cat . P.showChar ' ' . P.showsPrec 1 str . cpar Terminator minimumSize cat str -> opar . P.showString "Terminator" . P.showChar ' ' . P.showsPrec 1 minimumSize . P.showChar ' ' . P.showsPrec 1 cat . P.showChar ' ' . P.showsPrec 1 str . cpar Token x reg -> opar . P.showString "Token" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 reg . cpar NTerminal cat -> opar . P.showString "NTerminal" . P.showChar ' ' . P.showsPrec 1 cat . cpar Terminal str -> opar . P.showString "Terminal" . P.showChar ' ' . P.showsPrec 1 str . cpar IdCat x -> opar . P.showString "IdCat" . P.showChar ' ' . P.showsPrec 1 x . cpar ListCat cat -> opar . P.showString "ListCat" . P.showChar ' ' . P.showsPrec 1 cat . cpar LabF labelId1 labelId2 -> opar . P.showString "LabF" . P.showChar ' ' . P.showsPrec 1 labelId1 . P.showChar ' ' . P.showsPrec 1 labelId2 . cpar LabNoP labelId -> opar . P.showString "LabNoP" . P.showChar ' ' . P.showsPrec 1 labelId . cpar LabP labelId profItems -> opar . P.showString "LabP" . P.showChar ' ' . P.showsPrec 1 labelId . P.showChar ' ' . P.showsPrec 1 profItems . cpar LabPF labelId1 labelId2 profItems -> opar . P.showString "LabPF" . P.showChar ' ' . P.showsPrec 1 labelId1 . P.showChar ' ' . P.showsPrec 1 labelId2 . P.showChar ' ' . P.showsPrec 1 profItems . cpar Id x -> opar . P.showString "Id" . P.showChar ' ' . P.showsPrec 1 x . cpar ListCons -> P.showString "ListCons" ListE -> P.showString "ListE" ListOne -> P.showString "ListOne" Wild -> P.showString "Wild" ProfIt intLists integers -> opar . P.showString "ProfIt" . P.showChar ' ' . P.showsPrec 1 intLists . P.showChar ' ' . P.showsPrec 1 integers . cpar Ints integers -> opar . P.showString "Ints" . P.showChar ' ' . P.showsPrec 1 integers . cpar MkRHS items -> opar . P.showString "MkRHS" . P.showChar ' ' . P.showsPrec 1 items . cpar MEmpty -> P.showString "MEmpty" MNonempty -> P.showString "MNonempty" RAlt reg1 reg2 -> opar . P.showString "RAlt" . P.showChar ' ' . P.showsPrec 1 reg1 . P.showChar ' ' . P.showsPrec 1 reg2 . cpar RAlts str -> opar . P.showString "RAlts" . P.showChar ' ' . P.showsPrec 1 str . cpar RAny -> P.showString "RAny" RChar c -> opar . P.showString "RChar" . P.showChar ' ' . P.showsPrec 1 c . cpar RDigit -> P.showString "RDigit" REps -> P.showString "REps" RLetter -> P.showString "RLetter" RLower -> P.showString "RLower" RMinus reg1 reg2 -> opar . P.showString "RMinus" . P.showChar ' ' . P.showsPrec 1 reg1 . P.showChar ' ' . P.showsPrec 1 reg2 . cpar ROpt reg -> opar . P.showString "ROpt" . P.showChar ' ' . P.showsPrec 1 reg . cpar RPlus reg -> opar . P.showString "RPlus" . P.showChar ' ' . P.showsPrec 1 reg . cpar RSeq reg1 reg2 -> opar . P.showString "RSeq" . P.showChar ' ' . P.showsPrec 1 reg1 . P.showChar ' ' . P.showsPrec 1 reg2 . cpar RSeqs str -> opar . P.showString "RSeqs" . P.showChar ' ' . P.showsPrec 1 str . cpar RStar reg -> opar . P.showString "RStar" . P.showChar ' ' . P.showsPrec 1 reg . cpar RUpper -> P.showString "RUpper" where opar = if n > 0 then P.showChar '(' else P.id cpar = if n > 0 then P.showChar ')' else P.id instance P.Eq (Tree c) where (==) = johnMajorEq instance P.Ord (Tree c) where compare x y = P.compare (index x) (index y) `P.mappend` compareSame x y index :: Tree c -> P.Int index (MkGrammar _) = 1 index (Coercions _ _) = 2 index (Comment _) = 3 index (Comments _ _) = 4 index (Entryp _) = 5 index (Internal _ _ _) = 6 index (Layout _) = 7 index (LayoutStop _) = 8 index (LayoutTop ) = 9 index (PosToken _ _) = 10 index (Rule _ _ _) = 11 index (Rules _ _) = 12 index (Separator _ _ _) = 13 index (Terminator _ _ _) = 14 index (Token _ _) = 15 index (NTerminal _) = 16 index (Terminal _) = 17 index (IdCat _) = 18 index (ListCat _) = 19 index (LabF _ _) = 20 index (LabNoP _) = 21 index (LabP _ _) = 22 index (LabPF _ _ _) = 23 index (Id _) = 24 index (ListCons ) = 25 index (ListE ) = 26 index (ListOne ) = 27 index (Wild ) = 28 index (ProfIt _ _) = 29 index (Ints _) = 30 index (MkRHS _) = 31 index (MEmpty ) = 32 index (MNonempty ) = 33 index (RAlt _ _) = 34 index (RAlts _) = 35 index (RAny ) = 36 index (RChar _) = 37 index (RDigit ) = 38 index (REps ) = 39 index (RLetter ) = 40 index (RLower ) = 41 index (RMinus _ _) = 42 index (ROpt _) = 43 index (RPlus _) = 44 index (RSeq _ _) = 45 index (RSeqs _) = 46 index (RStar _) = 47 index (RUpper ) = 48 index (Ident _) = 49 johnMajorEq :: Tree a -> Tree b -> P.Bool johnMajorEq (MkGrammar defs) (MkGrammar defs_) = defs == defs_ johnMajorEq (Coercions x n) (Coercions x_ n_) = x == x_ && n == n_ johnMajorEq (Comment str) (Comment str_) = str == str_ johnMajorEq (Comments str1 str2) (Comments str1_ str2_) = str1 == str1_ && str2 == str2_ johnMajorEq (Entryp idents) (Entryp idents_) = idents == idents_ johnMajorEq (Internal label cat items) (Internal label_ cat_ items_) = label == label_ && cat == cat_ && items == items_ johnMajorEq (Layout strings) (Layout strings_) = strings == strings_ johnMajorEq (LayoutStop strings) (LayoutStop strings_) = strings == strings_ johnMajorEq LayoutTop LayoutTop = P.True johnMajorEq (PosToken x reg) (PosToken x_ reg_) = x == x_ && reg == reg_ johnMajorEq (Rule label cat items) (Rule label_ cat_ items_) = label == label_ && cat == cat_ && items == items_ johnMajorEq (Rules x rHSs) (Rules x_ rHSs_) = x == x_ && rHSs == rHSs_ johnMajorEq (Separator minimumSize cat str) (Separator minimumSize_ cat_ str_) = minimumSize == minimumSize_ && cat == cat_ && str == str_ johnMajorEq (Terminator minimumSize cat str) (Terminator minimumSize_ cat_ str_) = minimumSize == minimumSize_ && cat == cat_ && str == str_ johnMajorEq (Token x reg) (Token x_ reg_) = x == x_ && reg == reg_ johnMajorEq (NTerminal cat) (NTerminal cat_) = cat == cat_ johnMajorEq (Terminal str) (Terminal str_) = str == str_ johnMajorEq (IdCat x) (IdCat x_) = x == x_ johnMajorEq (ListCat cat) (ListCat cat_) = cat == cat_ johnMajorEq (LabF labelId1 labelId2) (LabF labelId1_ labelId2_) = labelId1 == labelId1_ && labelId2 == labelId2_ johnMajorEq (LabNoP labelId) (LabNoP labelId_) = labelId == labelId_ johnMajorEq (LabP labelId profItems) (LabP labelId_ profItems_) = labelId == labelId_ && profItems == profItems_ johnMajorEq (LabPF labelId1 labelId2 profItems) (LabPF labelId1_ labelId2_ profItems_) = labelId1 == labelId1_ && labelId2 == labelId2_ && profItems == profItems_ johnMajorEq (Id x) (Id x_) = x == x_ johnMajorEq ListCons ListCons = P.True johnMajorEq ListE ListE = P.True johnMajorEq ListOne ListOne = P.True johnMajorEq Wild Wild = P.True johnMajorEq (ProfIt intLists integers) (ProfIt intLists_ integers_) = intLists == intLists_ && integers == integers_ johnMajorEq (Ints integers) (Ints integers_) = integers == integers_ johnMajorEq (MkRHS items) (MkRHS items_) = items == items_ johnMajorEq MEmpty MEmpty = P.True johnMajorEq MNonempty MNonempty = P.True johnMajorEq (RAlt reg1 reg2) (RAlt reg1_ reg2_) = reg1 == reg1_ && reg2 == reg2_ johnMajorEq (RAlts str) (RAlts str_) = str == str_ johnMajorEq RAny RAny = P.True johnMajorEq (RChar c) (RChar c_) = c == c_ johnMajorEq RDigit RDigit = P.True johnMajorEq REps REps = P.True johnMajorEq RLetter RLetter = P.True johnMajorEq RLower RLower = P.True johnMajorEq (RMinus reg1 reg2) (RMinus reg1_ reg2_) = reg1 == reg1_ && reg2 == reg2_ johnMajorEq (ROpt reg) (ROpt reg_) = reg == reg_ johnMajorEq (RPlus reg) (RPlus reg_) = reg == reg_ johnMajorEq (RSeq reg1 reg2) (RSeq reg1_ reg2_) = reg1 == reg1_ && reg2 == reg2_ johnMajorEq (RSeqs str) (RSeqs str_) = str == str_ johnMajorEq (RStar reg) (RStar reg_) = reg == reg_ johnMajorEq RUpper RUpper = P.True johnMajorEq (Ident str) (Ident str_) = str == str_ johnMajorEq _ _ = P.False compareSame :: Tree c -> Tree c -> P.Ordering compareSame (MkGrammar defs) (MkGrammar defs_) = P.compare defs defs_ compareSame (Coercions x n) (Coercions x_ n_) = P.mappend (P.compare x x_) (P.compare n n_) compareSame (Comment str) (Comment str_) = P.compare str str_ compareSame (Comments str1 str2) (Comments str1_ str2_) = P.mappend (P.compare str1 str1_) (P.compare str2 str2_) compareSame (Entryp idents) (Entryp idents_) = P.compare idents idents_ compareSame (Internal label cat items) (Internal label_ cat_ items_) = P.mappend (P.compare label label_) (P.mappend (P.compare cat cat_) (P.compare items items_)) compareSame (Layout strings) (Layout strings_) = P.compare strings strings_ compareSame (LayoutStop strings) (LayoutStop strings_) = P.compare strings strings_ compareSame LayoutTop LayoutTop = P.EQ compareSame (PosToken x reg) (PosToken x_ reg_) = P.mappend (P.compare x x_) (P.compare reg reg_) compareSame (Rule label cat items) (Rule label_ cat_ items_) = P.mappend (P.compare label label_) (P.mappend (P.compare cat cat_) (P.compare items items_)) compareSame (Rules x rHSs) (Rules x_ rHSs_) = P.mappend (P.compare x x_) (P.compare rHSs rHSs_) compareSame (Separator minimumSize cat str) (Separator minimumSize_ cat_ str_) = P.mappend (P.compare minimumSize minimumSize_) (P.mappend (P.compare cat cat_) (P.compare str str_)) compareSame (Terminator minimumSize cat str) (Terminator minimumSize_ cat_ str_) = P.mappend (P.compare minimumSize minimumSize_) (P.mappend (P.compare cat cat_) (P.compare str str_)) compareSame (Token x reg) (Token x_ reg_) = P.mappend (P.compare x x_) (P.compare reg reg_) compareSame (NTerminal cat) (NTerminal cat_) = P.compare cat cat_ compareSame (Terminal str) (Terminal str_) = P.compare str str_ compareSame (IdCat x) (IdCat x_) = P.compare x x_ compareSame (ListCat cat) (ListCat cat_) = P.compare cat cat_ compareSame (LabF labelId1 labelId2) (LabF labelId1_ labelId2_) = P.mappend (P.compare labelId1 labelId1_) (P.compare labelId2 labelId2_) compareSame (LabNoP labelId) (LabNoP labelId_) = P.compare labelId labelId_ compareSame (LabP labelId profItems) (LabP labelId_ profItems_) = P.mappend (P.compare labelId labelId_) (P.compare profItems profItems_) compareSame (LabPF labelId1 labelId2 profItems) (LabPF labelId1_ labelId2_ profItems_) = P.mappend (P.compare labelId1 labelId1_) (P.mappend (P.compare labelId2 labelId2_) (P.compare profItems profItems_)) compareSame (Id x) (Id x_) = P.compare x x_ compareSame ListCons ListCons = P.EQ compareSame ListE ListE = P.EQ compareSame ListOne ListOne = P.EQ compareSame Wild Wild = P.EQ compareSame (ProfIt intLists integers) (ProfIt intLists_ integers_) = P.mappend (P.compare intLists intLists_) (P.compare integers integers_) compareSame (Ints integers) (Ints integers_) = P.compare integers integers_ compareSame (MkRHS items) (MkRHS items_) = P.compare items items_ compareSame MEmpty MEmpty = P.EQ compareSame MNonempty MNonempty = P.EQ compareSame (RAlt reg1 reg2) (RAlt reg1_ reg2_) = P.mappend (P.compare reg1 reg1_) (P.compare reg2 reg2_) compareSame (RAlts str) (RAlts str_) = P.compare str str_ compareSame RAny RAny = P.EQ compareSame (RChar c) (RChar c_) = P.compare c c_ compareSame RDigit RDigit = P.EQ compareSame REps REps = P.EQ compareSame RLetter RLetter = P.EQ compareSame RLower RLower = P.EQ compareSame (RMinus reg1 reg2) (RMinus reg1_ reg2_) = P.mappend (P.compare reg1 reg1_) (P.compare reg2 reg2_) compareSame (ROpt reg) (ROpt reg_) = P.compare reg reg_ compareSame (RPlus reg) (RPlus reg_) = P.compare reg reg_ compareSame (RSeq reg1 reg2) (RSeq reg1_ reg2_) = P.mappend (P.compare reg1 reg1_) (P.compare reg2 reg2_) compareSame (RSeqs str) (RSeqs str_) = P.compare str str_ compareSame (RStar reg) (RStar reg_) = P.compare reg reg_ compareSame RUpper RUpper = P.EQ compareSame (Ident str) (Ident str_) = P.compare str str_ compareSame _ _ = P.error "BNFC error: compareSame"