-- 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 AbsProlog ( Tree(..) , Database , Clause , Predicate , Term , Atom , Var , List , Ident , UIdent , LIdent , Wild , johnMajorEq , module ComposOpProlog ) where import Prelude ((.), (>), (&&), (==)) import Prelude ((.), (>), (&&), (==)) import qualified Prelude as P import ComposOpProlog data Tag = Database_ | Clause_ | Predicate_ | Term_ | Atom_ | Var_ | List_ | Ident_ | UIdent_ | LIdent_ | Wild_ type Database = Tree 'Database_ type Clause = Tree 'Clause_ type Predicate = Tree 'Predicate_ type Term = Tree 'Term_ type Atom = Tree 'Atom_ type Var = Tree 'Var_ type List = Tree 'List_ type Ident = Tree 'Ident_ type UIdent = Tree 'UIdent_ type LIdent = Tree 'LIdent_ type Wild = Tree 'Wild_ data Tree (a :: Tag) where Db :: [Clause] -> Tree 'Database_ Directive :: [Predicate] -> Tree 'Clause_ Fact :: Predicate -> Tree 'Clause_ Rule :: Predicate -> [Predicate] -> Tree 'Clause_ APred :: Atom -> Tree 'Predicate_ CPred :: Atom -> [Term] -> Tree 'Predicate_ Complex :: Atom -> [Term] -> Tree 'Term_ TAtom :: Atom -> Tree 'Term_ TList :: List -> Tree 'Term_ VarT :: Var -> Tree 'Term_ Atm :: LIdent -> Tree 'Atom_ EAtm :: Ident -> Tree 'Atom_ A :: Wild -> Tree 'Var_ V :: UIdent -> Tree 'Var_ Cons :: [Term] -> List -> Tree 'List_ ConsV :: [Term] -> Var -> Tree 'List_ Empty :: Tree 'List_ Enum :: [Term] -> Tree 'List_ Ident ::P.String -> Tree 'Ident_ UIdent ::P.String -> Tree 'UIdent_ LIdent ::P.String -> Tree 'LIdent_ Wild ::P.String -> Tree 'Wild_ instance Compos Tree where compos r a f = \case Db clauses -> r Db `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) clauses Directive predicates -> r Directive `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) predicates Fact predicate -> r Fact `a` f predicate Rule predicate predicates -> r Rule `a` f predicate `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) predicates APred atom -> r APred `a` f atom CPred atom terms -> r CPred `a` f atom `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) terms Complex atom terms -> r Complex `a` f atom `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) terms TAtom atom -> r TAtom `a` f atom TList list -> r TList `a` f list VarT var -> r VarT `a` f var Atm lIdent -> r Atm `a` f lIdent EAtm x -> r EAtm `a` f x A wild -> r A `a` f wild V uIdent -> r V `a` f uIdent Cons terms list -> r Cons `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) terms `a` f list ConsV terms var -> r ConsV `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) terms `a` f var Enum terms -> r Enum `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) terms 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 UIdent str -> opar . P.showString "UIdent" . P.showChar ' ' . P.showsPrec 1 str . cpar LIdent str -> opar . P.showString "LIdent" . P.showChar ' ' . P.showsPrec 1 str . cpar Wild str -> opar . P.showString "Wild" . P.showChar ' ' . P.showsPrec 1 str . cpar Db clauses -> opar . P.showString "Db" . P.showChar ' ' . P.showsPrec 1 clauses . cpar Directive predicates -> opar . P.showString "Directive" . P.showChar ' ' . P.showsPrec 1 predicates . cpar Fact predicate -> opar . P.showString "Fact" . P.showChar ' ' . P.showsPrec 1 predicate . cpar Rule predicate predicates -> opar . P.showString "Rule" . P.showChar ' ' . P.showsPrec 1 predicate . P.showChar ' ' . P.showsPrec 1 predicates . cpar APred atom -> opar . P.showString "APred" . P.showChar ' ' . P.showsPrec 1 atom . cpar CPred atom terms -> opar . P.showString "CPred" . P.showChar ' ' . P.showsPrec 1 atom . P.showChar ' ' . P.showsPrec 1 terms . cpar Complex atom terms -> opar . P.showString "Complex" . P.showChar ' ' . P.showsPrec 1 atom . P.showChar ' ' . P.showsPrec 1 terms . cpar TAtom atom -> opar . P.showString "TAtom" . P.showChar ' ' . P.showsPrec 1 atom . cpar TList list -> opar . P.showString "TList" . P.showChar ' ' . P.showsPrec 1 list . cpar VarT var -> opar . P.showString "VarT" . P.showChar ' ' . P.showsPrec 1 var . cpar Atm lIdent -> opar . P.showString "Atm" . P.showChar ' ' . P.showsPrec 1 lIdent . cpar EAtm x -> opar . P.showString "EAtm" . P.showChar ' ' . P.showsPrec 1 x . cpar A wild -> opar . P.showString "A" . P.showChar ' ' . P.showsPrec 1 wild . cpar V uIdent -> opar . P.showString "V" . P.showChar ' ' . P.showsPrec 1 uIdent . cpar Cons terms list -> opar . P.showString "Cons" . P.showChar ' ' . P.showsPrec 1 terms . P.showChar ' ' . P.showsPrec 1 list . cpar ConsV terms var -> opar . P.showString "ConsV" . P.showChar ' ' . P.showsPrec 1 terms . P.showChar ' ' . P.showsPrec 1 var . cpar Empty -> P.showString "Empty" Enum terms -> opar . P.showString "Enum" . P.showChar ' ' . P.showsPrec 1 terms . cpar 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 (Db _) = 1 index (Directive _) = 2 index (Fact _) = 3 index (Rule _ _) = 4 index (APred _) = 5 index (CPred _ _) = 6 index (Complex _ _) = 7 index (TAtom _) = 8 index (TList _) = 9 index (VarT _) = 10 index (Atm _) = 11 index (EAtm _) = 12 index (A _) = 13 index (V _) = 14 index (Cons _ _) = 15 index (ConsV _ _) = 16 index (Empty ) = 17 index (Enum _) = 18 index (Ident _) = 19 index (UIdent _) = 20 index (LIdent _) = 21 index (Wild _) = 22 johnMajorEq :: Tree a -> Tree b -> P.Bool johnMajorEq (Db clauses) (Db clauses_) = clauses == clauses_ johnMajorEq (Directive predicates) (Directive predicates_) = predicates == predicates_ johnMajorEq (Fact predicate) (Fact predicate_) = predicate == predicate_ johnMajorEq (Rule predicate predicates) (Rule predicate_ predicates_) = predicate == predicate_ && predicates == predicates_ johnMajorEq (APred atom) (APred atom_) = atom == atom_ johnMajorEq (CPred atom terms) (CPred atom_ terms_) = atom == atom_ && terms == terms_ johnMajorEq (Complex atom terms) (Complex atom_ terms_) = atom == atom_ && terms == terms_ johnMajorEq (TAtom atom) (TAtom atom_) = atom == atom_ johnMajorEq (TList list) (TList list_) = list == list_ johnMajorEq (VarT var) (VarT var_) = var == var_ johnMajorEq (Atm lIdent) (Atm lIdent_) = lIdent == lIdent_ johnMajorEq (EAtm x) (EAtm x_) = x == x_ johnMajorEq (A wild) (A wild_) = wild == wild_ johnMajorEq (V uIdent) (V uIdent_) = uIdent == uIdent_ johnMajorEq (Cons terms list) (Cons terms_ list_) = terms == terms_ && list == list_ johnMajorEq (ConsV terms var) (ConsV terms_ var_) = terms == terms_ && var == var_ johnMajorEq Empty Empty = P.True johnMajorEq (Enum terms) (Enum terms_) = terms == terms_ johnMajorEq (Ident str) (Ident str_) = str == str_ johnMajorEq (UIdent str) (UIdent str_) = str == str_ johnMajorEq (LIdent str) (LIdent str_) = str == str_ johnMajorEq (Wild str) (Wild str_) = str == str_ johnMajorEq _ _ = P.False compareSame :: Tree c -> Tree c -> P.Ordering compareSame (Db clauses) (Db clauses_) = P.compare clauses clauses_ compareSame (Directive predicates) (Directive predicates_) = P.compare predicates predicates_ compareSame (Fact predicate) (Fact predicate_) = P.compare predicate predicate_ compareSame (Rule predicate predicates) (Rule predicate_ predicates_) = P.mappend (P.compare predicate predicate_) (P.compare predicates predicates_) compareSame (APred atom) (APred atom_) = P.compare atom atom_ compareSame (CPred atom terms) (CPred atom_ terms_) = P.mappend (P.compare atom atom_) (P.compare terms terms_) compareSame (Complex atom terms) (Complex atom_ terms_) = P.mappend (P.compare atom atom_) (P.compare terms terms_) compareSame (TAtom atom) (TAtom atom_) = P.compare atom atom_ compareSame (TList list) (TList list_) = P.compare list list_ compareSame (VarT var) (VarT var_) = P.compare var var_ compareSame (Atm lIdent) (Atm lIdent_) = P.compare lIdent lIdent_ compareSame (EAtm x) (EAtm x_) = P.compare x x_ compareSame (A wild) (A wild_) = P.compare wild wild_ compareSame (V uIdent) (V uIdent_) = P.compare uIdent uIdent_ compareSame (Cons terms list) (Cons terms_ list_) = P.mappend (P.compare terms terms_) (P.compare list list_) compareSame (ConsV terms var) (ConsV terms_ var_) = P.mappend (P.compare terms terms_) (P.compare var var_) compareSame Empty Empty = P.EQ compareSame (Enum terms) (Enum terms_) = P.compare terms terms_ compareSame (Ident str) (Ident str_) = P.compare str str_ compareSame (UIdent str) (UIdent str_) = P.compare str str_ compareSame (LIdent str) (LIdent str_) = P.compare str str_ compareSame (Wild str) (Wild str_) = P.compare str str_ compareSame _ _ = P.error "BNFC error: compareSame"