{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies, UndecidableInstances, ExistentialQuantification, ScopedTypeVariables, StandaloneDeriving #-}
-- {-# LANGUAGE AllowAmbiguousTypes #-}

-------------------------------------------------------------------------------------------
--- Constraint Handling Rules
-------------------------------------------------------------------------------------------

{- |
The representation of rules, which should allow an implementation of:

"A Flexible Search Framework for CHR", Leslie De Koninck, Tom Schrijvers, and Bart Demoen.
http://link.springer.com/10.1007/978-3-540-92243-8_2

-}

module CHR.Types.Rule
  ( RuleBodyAlt(..)
  
  , Rule(..)
  , ruleBody, ruleBody'
  , ruleSz
    
  , (/\)
  , (\/)
  , (\!)
  , (<=>>), (==>>), (<\>>)
  , (<==>), (<=>), (==>), (<\>)
  , (|>), (=|)
  , (=!), (=!!)
  , (=@), (@=)
  )
  where

import           Data.Monoid
import           Data.List as List
import           Data.Typeable
import qualified Data.Set as Set

import qualified CHR.Data.TreeTrie              as TT
import           CHR.Data.VarMp
import           CHR.Utils
import           CHR.Pretty
import           CHR.Data.Substitutable

import           Control.Monad

-------------------------------------------------------------------------------------------
--- CHR, derived structures
-------------------------------------------------------------------------------------------

data RuleBodyAlt cnstr bprio
  = RuleBodyAlt
      { forall cnstr bprio. RuleBodyAlt cnstr bprio -> Maybe bprio
rbodyaltBacktrackPrio       :: !(Maybe bprio)        -- ^ optional backtrack priority, if absent it is inherited from the active backtrack prio
      , forall cnstr bprio. RuleBodyAlt cnstr bprio -> [cnstr]
rbodyaltBody                :: ![cnstr]             -- ^ body constraints to be dealt with by rules
      -- , rbodyaltBodyBuiltin         :: ![builtin]           -- ^ builtin constraints to be dealt with by builtin solving
      }
  deriving (Typeable)

instance Show (RuleBodyAlt c bp) where
  show :: RuleBodyAlt c bp -> String
show RuleBodyAlt c bp
_ = String
"RuleBodyAlt"

instance (PP bp, PP c) => PP (RuleBodyAlt c bp) where
  pp :: RuleBodyAlt c bp -> PP_Doc
pp RuleBodyAlt c bp
a = forall p. PP p => p -> PP_Doc
ppParens (forall cnstr bprio. RuleBodyAlt cnstr bprio -> Maybe bprio
rbodyaltBacktrackPrio RuleBodyAlt c bp
a) forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< forall a. PP a => [a] -> PP_Doc
ppCommas' (forall cnstr bprio. RuleBodyAlt cnstr bprio -> [cnstr]
rbodyaltBody RuleBodyAlt c bp
a)

-- | A CHR (rule) consist of head (simplification + propagation, boundary indicated by an Int), guard, and a body. All may be empty, but not all at the same time.
data Rule cnstr guard bprio prio
  = Rule
      { forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [cnstr]
ruleHead            :: ![cnstr]
      , forall cnstr guard bprio prio. Rule cnstr guard bprio prio -> Int
ruleSimpSz          :: !Int                -- ^ length of the part of the head which is the simplification part
      , forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [guard]
ruleGuard           :: ![guard]    
      , forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [RuleBodyAlt cnstr bprio]
ruleBodyAlts        :: ![RuleBodyAlt cnstr bprio]
      , forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> Maybe bprio
ruleBacktrackPrio   :: !(Maybe bprio)      -- ^ backtrack priority, should be something which can be substituted with the actual prio, later to be referred to at backtrack prios of alternatives
      , forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> Maybe prio
rulePrio            :: !(Maybe prio)       -- ^ rule priority, to choose between rules with equal backtrack priority
      , forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> Maybe String
ruleName            :: (Maybe String)
      }
  deriving (Typeable)

-- | Backwards compatibility: if only one alternative, extract it, ignore other alts
ruleBody' :: Rule c g bp p -> ([c],[c])
ruleBody' :: forall c g bp p. Rule c g bp p -> ([c], [c])
ruleBody' (Rule {ruleBodyAlts :: forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [RuleBodyAlt cnstr bprio]
ruleBodyAlts = (RuleBodyAlt c bp
a:[RuleBodyAlt c bp]
_)}) = (forall cnstr bprio. RuleBodyAlt cnstr bprio -> [cnstr]
rbodyaltBody RuleBodyAlt c bp
a, [])
ruleBody' (Rule {ruleBodyAlts :: forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [RuleBodyAlt cnstr bprio]
ruleBodyAlts = []   }) = ([], [])

-- | Backwards compatibility: if only one alternative, extract it, ignore other alts
ruleBody :: Rule c g bp p -> [c]
ruleBody :: forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [cnstr]
ruleBody = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c g bp p. Rule c g bp p -> ([c], [c])
ruleBody'
{-# INLINE ruleBody #-}


-- | Total nr of cnstrs in rule
ruleSz :: Rule c g bp p -> Int
ruleSz :: forall cnstr guard bprio prio. Rule cnstr guard bprio prio -> Int
ruleSz = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [cnstr]
ruleHead
{-# INLINE ruleSz #-}

emptyCHRGuard :: [a]
emptyCHRGuard :: forall a. [a]
emptyCHRGuard = []

instance Show (Rule c g bp p) where
  show :: Rule c g bp p -> String
show Rule c g bp p
_ = String
"Rule"

instance (PP c, PP g, PP p, PP bp) => PP (Rule c g bp p) where
  pp :: Rule c g bp p -> PP_Doc
pp Rule c g bp p
chr = forall x r a. (PP x, PP r) => (a -> x) -> Maybe a -> r -> PP_Doc
ppMbPre (\PP_Doc
p -> PP_Doc
p forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< String
"::") Maybe PP_Doc
rPrio forall a b. (a -> b) -> a -> b
$ forall x r a. (PP x, PP r) => (a -> x) -> Maybe a -> r -> PP_Doc
ppMbPre (\String
n -> forall p. PP p => p -> PP_Doc
pp String
n forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< String
"@") (forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> Maybe String
ruleName Rule c g bp p
chr) forall a b. (a -> b) -> a -> b
$ PP_Doc
base
    where base :: PP_Doc
base = case Rule c g bp p
chr of
            Rule {} | forall cnstr guard bprio prio. Rule cnstr guard bprio prio -> Int
ruleSimpSz Rule c g bp p
chr forall a. Eq a => a -> a -> Bool
== Int
0                        -> forall a. PP a => [a] -> PP_Doc
ppChr ([forall a. PP a => [a] -> PP_Doc
ppL (forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [cnstr]
ruleHead Rule c g bp p
chr), forall p. PP p => p -> PP_Doc
pp String
"==>"] forall a. [a] -> [a] -> [a]
++ forall {a}. PP a => [a] -> PP_Doc -> [PP_Doc]
ppGB (forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [guard]
ruleGuard Rule c g bp p
chr) PP_Doc
body)
                    | forall cnstr guard bprio prio. Rule cnstr guard bprio prio -> Int
ruleSimpSz Rule c g bp p
chr forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [cnstr]
ruleHead Rule c g bp p
chr)    -> forall a. PP a => [a] -> PP_Doc
ppChr ([forall a. PP a => [a] -> PP_Doc
ppL (forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [cnstr]
ruleHead Rule c g bp p
chr), forall p. PP p => p -> PP_Doc
pp String
"<=>"] forall a. [a] -> [a] -> [a]
++ forall {a}. PP a => [a] -> PP_Doc -> [PP_Doc]
ppGB (forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [guard]
ruleGuard Rule c g bp p
chr) PP_Doc
body)
                    | forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [cnstr]
ruleHead Rule c g bp p
chr) forall a. Eq a => a -> a -> Bool
== Int
0                 -> forall a. PP a => [a] -> PP_Doc
ppChr (forall {a}. PP a => [a] -> PP_Doc -> [PP_Doc]
ppGB (forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [guard]
ruleGuard Rule c g bp p
chr) PP_Doc
body)
                    | Bool
otherwise                                  -> forall a. PP a => [a] -> PP_Doc
ppChr ([forall a. PP a => [a] -> PP_Doc
ppL (forall a. Int -> [a] -> [a]
drop (forall cnstr guard bprio prio. Rule cnstr guard bprio prio -> Int
ruleSimpSz Rule c g bp p
chr) (forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [cnstr]
ruleHead Rule c g bp p
chr)), forall p. PP p => p -> PP_Doc
pp String
"\\", forall a. PP a => [a] -> PP_Doc
ppL (forall a. Int -> [a] -> [a]
take (forall cnstr guard bprio prio. Rule cnstr guard bprio prio -> Int
ruleSimpSz Rule c g bp p
chr) (forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [cnstr]
ruleHead Rule c g bp p
chr)), forall p. PP p => p -> PP_Doc
pp String
"<=>"] forall a. [a] -> [a] -> [a]
++ forall {a}. PP a => [a] -> PP_Doc -> [PP_Doc]
ppGB (forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [guard]
ruleGuard Rule c g bp p
chr) PP_Doc
body)
          rPrio :: Maybe PP_Doc
rPrio = case (forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> Maybe bprio
ruleBacktrackPrio Rule c g bp p
chr, forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> Maybe prio
rulePrio Rule c g bp p
chr) of
            (Maybe bp
Nothing, Maybe p
Nothing) -> forall a. Maybe a
Nothing
            (Just bp
bp, Just p
rp) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PP a => [a] -> PP_Doc
ppParensCommas [forall p. PP p => p -> PP_Doc
pp bp
bp , forall p. PP p => p -> PP_Doc
pp p
rp ]
            (Just bp
bp, Maybe p
_      ) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PP a => [a] -> PP_Doc
ppParensCommas [forall p. PP p => p -> PP_Doc
pp bp
bp , forall p. PP p => p -> PP_Doc
pp String
"_"]
            (Maybe bp
_      , Just p
rp) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PP a => [a] -> PP_Doc
ppParensCommas [forall p. PP p => p -> PP_Doc
pp String
"_", forall p. PP p => p -> PP_Doc
pp p
rp ]
          body :: PP_Doc
body = forall a. PP a => [a] -> PP_Doc
ppSpaces forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (forall p. PP p => p -> PP_Doc
pp String
"\\/") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall bp c. (PP bp, PP c) => RuleBodyAlt c bp -> PP_Doc
ppAlt forall a b. (a -> b) -> a -> b
$ forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [RuleBodyAlt cnstr bprio]
ruleBodyAlts Rule c g bp p
chr
            where ppAlt :: RuleBodyAlt a bprio -> PP_Doc
ppAlt RuleBodyAlt a bprio
a = forall x r a. (PP x, PP r) => (a -> x) -> Maybe a -> r -> PP_Doc
ppMbPre (\bprio
p -> forall p. PP p => p -> PP_Doc
ppParens bprio
p forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< String
"::") (forall cnstr bprio. RuleBodyAlt cnstr bprio -> Maybe bprio
rbodyaltBacktrackPrio RuleBodyAlt a bprio
a) forall a b. (a -> b) -> a -> b
$ forall a. PP a => [a] -> PP_Doc
ppL forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall p. PP p => p -> PP_Doc
pp (forall cnstr bprio. RuleBodyAlt cnstr bprio -> [cnstr]
rbodyaltBody RuleBodyAlt a bprio
a) -- ++ map pp (rbodyaltBodyBuiltin a)
          ppGB :: [a] -> PP_Doc -> [PP_Doc]
ppGB g :: [a]
g@(a
_:[a]
_) PP_Doc
b = [forall a. PP a => [a] -> PP_Doc
ppL [a]
g, String
"|" forall a b. (PP a, PP b) => a -> b -> PP_Doc
>#< PP_Doc
b] -- g b = ppListPre (\g -> ppL g >#< "|") g
          ppGB []      PP_Doc
b = [PP_Doc
b]
          -- ppL [x] = pp x
          ppL :: [a] -> PP_Doc
ppL [a]
xs  = forall a. PP a => [a] -> PP_Doc
ppCommas' [a]
xs -- ppParensCommasBlock xs
          ppChr :: [a] -> PP_Doc
ppChr [a]
l = forall a. PP a => [a] -> PP_Doc
ppSpaces [a]
l -- vlist l -- ppCurlysBlock

-- type instance TTKey (Rule cnstr guard bprio prio) = TTKey cnstr
type instance TT.TrTrKey (Rule cnstr guard bprio prio) = TT.TrTrKey cnstr

instance (TT.TreeTrieKeyable cnstr) => TT.TreeTrieKeyable (Rule cnstr guard bprio prio) where
  toTreeTriePreKey1 :: Rule cnstr guard bprio prio
-> PreKey1 (Rule cnstr guard bprio prio)
toTreeTriePreKey1 Rule cnstr guard bprio prio
chr = forall y x.
(TrTrKey y ~ TrTrKey x, TreeTrieKeyable y) =>
y -> PreKey1 x
TT.prekey1Delegate forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [cnstr]
ruleHead Rule cnstr guard bprio prio
chr

-------------------------------------------------------------------------------------------
--- Var instances
-------------------------------------------------------------------------------------------

type instance ExtrValVarKey (Rule c g bp p) = ExtrValVarKey c
type instance ExtrValVarKey (RuleBodyAlt c p) = ExtrValVarKey c

-- TBD: should vars be extracted from prio and builtin as well?
instance (VarExtractable c) => VarExtractable (RuleBodyAlt c p) where
  varFreeSet :: RuleBodyAlt c p -> Set (ExtrValVarKey (RuleBodyAlt c p))
varFreeSet          (RuleBodyAlt {rbodyaltBody :: forall cnstr bprio. RuleBodyAlt cnstr bprio -> [cnstr]
rbodyaltBody=[c]
b})
    = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall vv. VarExtractable vv => vv -> Set (ExtrValVarKey vv)
varFreeSet [c]
b

-- TBD: should vars be extracted from prio as well?
instance (VarExtractable c, VarExtractable g, ExtrValVarKey c ~ ExtrValVarKey g) => VarExtractable (Rule c g bp p) where
  varFreeSet :: Rule c g bp p -> Set (ExtrValVarKey (Rule c g bp p))
varFreeSet          (Rule {ruleHead :: forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [cnstr]
ruleHead=[c]
h, ruleGuard :: forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [guard]
ruleGuard=[g]
g, ruleBodyAlts :: forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [RuleBodyAlt cnstr bprio]
ruleBodyAlts=[RuleBodyAlt c bp]
b})
    = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a b. (a -> b) -> [a] -> [b]
map forall vv. VarExtractable vv => vv -> Set (ExtrValVarKey vv)
varFreeSet [c]
h, forall a b. (a -> b) -> [a] -> [b]
map forall vv. VarExtractable vv => vv -> Set (ExtrValVarKey vv)
varFreeSet [g]
g, forall a b. (a -> b) -> [a] -> [b]
map forall vv. VarExtractable vv => vv -> Set (ExtrValVarKey vv)
varFreeSet [RuleBodyAlt c bp]
b]

instance (VarUpdatable c s, VarUpdatable p s) => VarUpdatable (RuleBodyAlt c p) s where
  varUpd :: s -> RuleBodyAlt c p -> RuleBodyAlt c p
varUpd s
s r :: RuleBodyAlt c p
r@(RuleBodyAlt {rbodyaltBacktrackPrio :: forall cnstr bprio. RuleBodyAlt cnstr bprio -> Maybe bprio
rbodyaltBacktrackPrio=Maybe p
p, rbodyaltBody :: forall cnstr bprio. RuleBodyAlt cnstr bprio -> [cnstr]
rbodyaltBody=[c]
b})
    = RuleBodyAlt c p
r {rbodyaltBacktrackPrio :: Maybe p
rbodyaltBacktrackPrio = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall vv subst. VarUpdatable vv subst => subst -> vv -> vv
varUpd s
s) Maybe p
p, rbodyaltBody :: [c]
rbodyaltBody = forall a b. (a -> b) -> [a] -> [b]
map (forall vv subst. VarUpdatable vv subst => subst -> vv -> vv
varUpd s
s) [c]
b}

instance (VarUpdatable c s, VarUpdatable g s, VarUpdatable bp s, VarUpdatable p s) => VarUpdatable (Rule c g bp p) s where
  varUpd :: s -> Rule c g bp p -> Rule c g bp p
varUpd s
s r :: Rule c g bp p
r@(Rule {ruleHead :: forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [cnstr]
ruleHead=[c]
h, ruleGuard :: forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [guard]
ruleGuard=[g]
g, ruleBodyAlts :: forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [RuleBodyAlt cnstr bprio]
ruleBodyAlts=[RuleBodyAlt c bp]
b})
    = Rule c g bp p
r {ruleHead :: [c]
ruleHead = forall a b. (a -> b) -> [a] -> [b]
map (forall vv subst. VarUpdatable vv subst => subst -> vv -> vv
varUpd s
s) [c]
h, ruleGuard :: [g]
ruleGuard = forall a b. (a -> b) -> [a] -> [b]
map (forall vv subst. VarUpdatable vv subst => subst -> vv -> vv
varUpd s
s) [g]
g, ruleBodyAlts :: [RuleBodyAlt c bp]
ruleBodyAlts = forall a b. (a -> b) -> [a] -> [b]
map (forall vv subst. VarUpdatable vv subst => subst -> vv -> vv
varUpd s
s) [RuleBodyAlt c bp]
b}

-------------------------------------------------------------------------------------------
--- Construction: Rule
-------------------------------------------------------------------------------------------
  
mkRule :: [cnstr]
-> Int
-> [guard]
-> [cnstr]
-> p
-> Maybe prio
-> Rule cnstr guard bprio prio
mkRule [cnstr]
h Int
l [guard]
g [cnstr]
b p
bi Maybe prio
p = forall cnstr guard bprio prio.
[cnstr]
-> Int
-> [guard]
-> [RuleBodyAlt cnstr bprio]
-> Maybe bprio
-> Maybe prio
-> Maybe String
-> Rule cnstr guard bprio prio
Rule [cnstr]
h Int
l [guard]
g [forall cnstr bprio.
Maybe bprio -> [cnstr] -> RuleBodyAlt cnstr bprio
RuleBodyAlt forall a. Maybe a
Nothing [cnstr]
b] forall a. Maybe a
Nothing Maybe prio
p forall a. Maybe a
Nothing
guardRule :: [guard]
-> Rule cnstr guard bprio prio -> Rule cnstr guard bprio prio
guardRule [guard]
g Rule cnstr guard bprio prio
r = Rule cnstr guard bprio prio
r {ruleGuard :: [guard]
ruleGuard = forall cnstr guard bprio prio.
Rule cnstr guard bprio prio -> [guard]
ruleGuard Rule cnstr guard bprio prio
r forall a. [a] -> [a] -> [a]
++ [guard]
g}
prioritizeRule :: prio -> Rule cnstr guard bprio prio -> Rule cnstr guard bprio prio
prioritizeRule prio
p Rule cnstr guard bprio prio
r = Rule cnstr guard bprio prio
r {rulePrio :: Maybe prio
rulePrio = forall a. a -> Maybe a
Just prio
p}
prioritizeBacktrackRule :: bprio -> Rule cnstr guard bprio prio -> Rule cnstr guard bprio prio
prioritizeBacktrackRule bprio
p Rule cnstr guard bprio prio
r = Rule cnstr guard bprio prio
r {ruleBacktrackPrio :: Maybe bprio
ruleBacktrackPrio = forall a. a -> Maybe a
Just bprio
p}
labelRule :: String
-> Rule cnstr guard bprio prio -> Rule cnstr guard bprio prio
labelRule String
l Rule cnstr guard bprio prio
r = Rule cnstr guard bprio prio
r {ruleName :: Maybe String
ruleName = forall a. a -> Maybe a
Just String
l}


infixl  6 /\
infixl  5 \!
infixr  4 \/
infix   3 <==>, <=>, ==>, <\>
infixl  2 |>, =|
infixl  2 =!, =!!
infixl  2 =@
infixr  1 @=

-- | Rule body backtracking alternative
(/\) :: [c] -> [c] -> RuleBodyAlt c p
[c]
c /\ :: forall c p. [c] -> [c] -> RuleBodyAlt c p
/\ [c]
b = forall cnstr bprio.
Maybe bprio -> [cnstr] -> RuleBodyAlt cnstr bprio
RuleBodyAlt forall a. Maybe a
Nothing ([c]
c forall a. [a] -> [a] -> [a]
++ [c]
b)

-- | Rule body backtracking alternatives
(\/) :: [RuleBodyAlt c p] -> [RuleBodyAlt c p] -> [RuleBodyAlt c p]
\/ :: forall c p.
[RuleBodyAlt c p] -> [RuleBodyAlt c p] -> [RuleBodyAlt c p]
(\/) = forall a. [a] -> [a] -> [a]
(++)

-- | Add backtrack priority to body alternative
(\!) :: RuleBodyAlt c p -> p -> RuleBodyAlt c p
RuleBodyAlt c p
r \! :: forall c p. RuleBodyAlt c p -> p -> RuleBodyAlt c p
\! p
p = RuleBodyAlt c p
r {rbodyaltBacktrackPrio :: Maybe p
rbodyaltBacktrackPrio = forall a. a -> Maybe a
Just p
p}

-- | Construct simplification rule out of head, body, and builtin constraints
[a]
hs <=>> :: [a] -> ([a], p) -> Rule a guard bprio prio
<=>>  ([a]
bs,p
bis) = forall {cnstr} {guard} {p} {prio} {bprio}.
[cnstr]
-> Int
-> [guard]
-> [cnstr]
-> p
-> Maybe prio
-> Rule cnstr guard bprio prio
mkRule [a]
hs (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
hs) [] [a]
bs p
bis forall a. Maybe a
Nothing
-- | Construct propagation rule out of head, body, and builtin constraints
[cnstr]
hs  ==>> :: [cnstr] -> ([cnstr], p) -> Rule cnstr guard bprio prio
==>>  ([cnstr]
bs,p
bis) = forall {cnstr} {guard} {p} {prio} {bprio}.
[cnstr]
-> Int
-> [guard]
-> [cnstr]
-> p
-> Maybe prio
-> Rule cnstr guard bprio prio
mkRule [cnstr]
hs Int
0 [] [cnstr]
bs p
bis forall a. Maybe a
Nothing

-- | Construct simpagation rule out of head, body, and builtin constraints
([a]
hsprop,[a]
hssimp) <\>> :: ([a], [a]) -> ([a], p) -> Rule a guard bprio prio
<\>>  ([a]
bs,p
bis) = forall {cnstr} {guard} {p} {prio} {bprio}.
[cnstr]
-> Int
-> [guard]
-> [cnstr]
-> p
-> Maybe prio
-> Rule cnstr guard bprio prio
mkRule ([a]
hssimp forall a. [a] -> [a] -> [a]
++ [a]
hsprop) (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
hssimp) [] ([a]
bs) (p
bis) forall a. Maybe a
Nothing

-- | Construct simplification rule out of head and body constraints
[a]
hs <==> :: [a] -> [a] -> Rule a guard bprio prio
<==>  [a]
bs = forall {cnstr} {guard} {p} {prio} {bprio}.
[cnstr]
-> Int
-> [guard]
-> [cnstr]
-> p
-> Maybe prio
-> Rule cnstr guard bprio prio
mkRule ([a]
hs) (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
hs) [] ([a]
bs) [] forall a. Maybe a
Nothing
-- | Construct propagation rule out of head and body constraints
[cnstr]
hs  ==> :: [cnstr] -> [cnstr] -> Rule cnstr guard bprio prio
==>  [cnstr]
bs = forall {cnstr} {guard} {p} {prio} {bprio}.
[cnstr]
-> Int
-> [guard]
-> [cnstr]
-> p
-> Maybe prio
-> Rule cnstr guard bprio prio
mkRule ([cnstr]
hs) Int
0 [] ([cnstr]
bs) [] forall a. Maybe a
Nothing
<=> :: [a] -> [a] -> Rule a guard bprio prio
(<=>) = forall {a} {guard} {bprio} {prio}.
[a] -> [a] -> Rule a guard bprio prio
(<==>)

-- | Construct simpagation rule out of head and body constraints
([a]
hsprop,[a]
hssimp) <\> :: ([a], [a]) -> [a] -> Rule a guard bprio prio
<\>  [a]
bs = forall {cnstr} {guard} {p} {prio} {bprio}.
[cnstr]
-> Int
-> [guard]
-> [cnstr]
-> p
-> Maybe prio
-> Rule cnstr guard bprio prio
mkRule ([a]
hssimp forall a. [a] -> [a] -> [a]
++ [a]
hsprop) (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
hssimp) [] ([a]
bs) [] forall a. Maybe a
Nothing

{-# DEPRECATED (|>) "Use (=|)" #-}
-- | Add guards to rule
Rule cnstr guard bprio prio
r |> :: Rule cnstr guard bprio prio
-> [guard] -> Rule cnstr guard bprio prio
|> [guard]
g = forall {guard} {cnstr} {bprio} {prio}.
[guard]
-> Rule cnstr guard bprio prio -> Rule cnstr guard bprio prio
guardRule ([guard]
g) Rule cnstr guard bprio prio
r
=| :: Rule cnstr guard bprio prio
-> [guard] -> Rule cnstr guard bprio prio
(=|) = forall {cnstr} {guard} {bprio} {prio}.
Rule cnstr guard bprio prio
-> [guard] -> Rule cnstr guard bprio prio
(|>)
{-# INLINE (=|) #-}

-- | Add priority to rule
Rule cnstr guard bprio prio
r =!! :: Rule cnstr guard bprio prio -> prio -> Rule cnstr guard bprio prio
=!! prio
p = forall {prio} {cnstr} {guard} {bprio} {prio}.
prio -> Rule cnstr guard bprio prio -> Rule cnstr guard bprio prio
prioritizeRule (prio
p) Rule cnstr guard bprio prio
r

-- | Add backtrack priority to rule
Rule cnstr guard bprio prio
r =! :: Rule cnstr guard bprio prio -> bprio -> Rule cnstr guard bprio prio
=! bprio
p = forall {bprio} {cnstr} {guard} {prio}.
bprio -> Rule cnstr guard bprio prio -> Rule cnstr guard bprio prio
prioritizeBacktrackRule (bprio
p) Rule cnstr guard bprio prio
r

-- | Add label to rule
Rule cnstr guard bprio prio
r =@ :: Rule cnstr guard bprio prio
-> String -> Rule cnstr guard bprio prio
=@ String
l = forall {cnstr} {guard} {bprio} {prio}.
String
-> Rule cnstr guard bprio prio -> Rule cnstr guard bprio prio
labelRule String
l Rule cnstr guard bprio prio
r

-- | Add label to rule
String
l @= :: String
-> Rule cnstr guard bprio prio -> Rule cnstr guard bprio prio
@= Rule cnstr guard bprio prio
r = Rule cnstr guard bprio prio
r forall {cnstr} {guard} {bprio} {prio}.
Rule cnstr guard bprio prio
-> String -> Rule cnstr guard bprio prio
=@ String
l
{-# INLINE (@=) #-}