packages feed

twee-lib 2.1 → 2.1.1

raw patch · 86 files changed

+5787/−8278 lines, 86 files

Files

+ Data/ChurchList.hs view
@@ -0,0 +1,99 @@+-- Church-encoded lists. Used in Twee.CP to make sure that fusion happens.+{-# LANGUAGE Rank2Types, BangPatterns #-}+module Data.ChurchList where++import Prelude(Functor(..), Applicative(..), Monad(..), Bool(..), Maybe(..), (.), ($), id)+import qualified Prelude+import GHC.Magic(oneShot)+import GHC.Exts(build)+import Control.Monad(MonadPlus(..), liftM2)+import Control.Applicative(Alternative(..))++newtype ChurchList a =+  ChurchList (forall b. (a -> b -> b) -> b -> b)++{-# INLINE foldr #-}+foldr :: (a -> b -> b) -> b -> ChurchList a -> b+foldr op e (ChurchList f) = eta (f op (eta e))+  -- Using eta here seems to help with eta-expanding foldl'++{-# INLINE[0] eta #-}+eta :: a -> a+eta x = x+{-# RULES "eta" forall f. eta f = \x -> f x #-}++{-# INLINE nil #-}+nil :: ChurchList a+nil = ChurchList (\_ n -> n)++{-# INLINE unit #-}+unit :: a -> ChurchList a+unit x = ChurchList (\c n -> c x n)++{-# INLINE cons #-}+cons :: a -> ChurchList a -> ChurchList a+cons x xs = ChurchList (\c n -> c x (foldr c n xs))++{-# INLINE append #-}+append :: ChurchList a -> ChurchList a -> ChurchList a+append xs ys = ChurchList (\c n -> foldr c (foldr c n ys) xs)++{-# INLINE join #-}+join :: ChurchList (ChurchList a) -> ChurchList a+join xss = ChurchList (\c n -> foldr (\xs ys -> foldr c ys xs) n xss)++instance Functor ChurchList where+  {-# INLINE fmap #-}+  fmap f xs = ChurchList (\c n -> foldr (c . f) n xs)++instance Applicative ChurchList where+  {-# INLINE pure #-}+  pure = return+  {-# INLINE (<*>) #-}+  (<*>) = liftM2 ($)++instance Monad ChurchList where+  {-# INLINE return #-}+  return = unit+  {-# INLINE (>>=) #-}+  xs >>= f = join (fmap f xs)++instance Alternative ChurchList where+  {-# INLINE empty #-}+  empty = nil+  {-# INLINE (<|>) #-}+  (<|>) = append++instance MonadPlus ChurchList where+  {-# INLINE mzero #-}+  mzero = empty+  {-# INLINE mplus #-}+  mplus = (<|>)++{-# INLINE fromList #-}+fromList :: [a] -> ChurchList a+fromList xs = ChurchList (\c n -> Prelude.foldr c n xs)++{-# INLINE toList #-}+toList :: ChurchList a -> [a]+toList (ChurchList f) = build f++{-# INLINE foldl' #-}+foldl' :: (b -> a -> b) -> b -> ChurchList a -> b+foldl' op e xs =+  foldr (\x f -> oneShot (\ (!acc) -> f (op acc x))) id xs e++{-# INLINE filter #-}+filter :: (a -> Bool) -> ChurchList a -> ChurchList a+filter p xs =+  ChurchList $ \c n ->+    let            +      {-# INLINE op #-}+      op x xs = if p x then c x xs else xs+    in+      foldr op n xs++{-# INLINE fromMaybe #-}+fromMaybe :: Maybe a -> ChurchList a+fromMaybe Nothing = nil+fromMaybe (Just x) = unit x
+ Data/DynamicArray.hs view
@@ -0,0 +1,67 @@+-- | Zero-indexed dynamic arrays, optimised for lookup.+-- Modification is slow. Uninitialised indices have a default value.+{-# LANGUAGE CPP #-}+module Data.DynamicArray where++#ifdef BOUNDS_CHECKS+import qualified Data.Primitive.SmallArray.Checked as P+#else+import qualified Data.Primitive.SmallArray as P+#endif+import Control.Monad.ST+import Data.List++-- | A type which has a default value.+class Default a where+  -- | The default value.+  def :: a++-- | An array.+data Array a =+  Array {+    -- | The size of the array.+    arraySize     :: {-# UNPACK #-} !Int,+    -- | The contents of the array.+    arrayContents :: {-# UNPACK #-} !(P.SmallArray a) }++-- | Convert an array to a list of (index, value) pairs.+{-# INLINE toList #-}+toList :: Array a -> [(Int, a)]+toList arr =+  [ (i, x)+  | i <- [0..arraySize arr-1],+    let x = P.indexSmallArray (arrayContents arr) i ]++instance Show a => Show (Array a) where+  show arr =+    "{" +++    intercalate ", "+      [ show i ++ "->" ++ show x+      | (i, x) <- toList arr ] +++    "}"++-- | Create an empty array.+newArray :: Default a => Array a+newArray = runST $ do+  marr <- P.newSmallArray 0 def+  arr  <- P.unsafeFreezeSmallArray marr+  return (Array 0 arr)++-- | Index into an array. O(1) time.+{-# INLINE (!) #-}+(!) :: Default a => Array a -> Int -> a+arr ! n+  | 0 <= n && n < arraySize arr =+    P.indexSmallArray (arrayContents arr) n+  | otherwise = def++-- | Update the array. O(n) time.+{-# INLINEABLE update #-}+update :: Default a => Int -> a -> Array a -> Array a+update n x arr = runST $ do+  let size = arraySize arr `max` (n+1)+  marr <- P.newSmallArray size def+  P.copySmallArray marr 0 (arrayContents arr) 0 (arraySize arr)+  P.writeSmallArray marr n $! x+  arr' <- P.unsafeFreezeSmallArray marr+  return (Array size arr')
+ Data/Heap.hs view
@@ -0,0 +1,154 @@+-- | Skew heaps.++{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}+module Data.Heap(+  Heap, empty, singleton, insert, removeMin, union, mapMaybe, size) where++-- | A heap.++-- Representation: the size of the heap, and the heap itself.+data Heap a = Heap {-# UNPACK #-} !Int !(Heap1 a) deriving Show+-- N.B.: arguments are not strict so code has to take care+-- to force stuff appropriately.+data Heap1 a = Nil | Node a (Heap1 a) (Heap1 a) deriving Show++-- | Take the union of two heaps.+{-# INLINEABLE union #-}+union :: Ord a => Heap a -> Heap a -> Heap a+union (Heap n1 h1) (Heap n2 h2) = Heap (n1+n2) (union1 h1 h2)++{-# INLINEABLE union1 #-}+union1 :: forall a. Ord a => Heap1 a -> Heap1 a -> Heap1 a+union1 = u1+  where+    -- The generated code is better when we do everything+    -- through this u1 function instead of union1...+    -- This is because u1 has no Ord constraint in its type.+    u1 :: Heap1 a -> Heap1 a -> Heap1 a+    u1 Nil h = h+    u1 h Nil = h+    u1 h1@(Node x1 l1 r1) h2@(Node x2 l2 r2)+      | x1 <= x2 = (Node x1 $! u1 r1 h2) l1+      | otherwise = (Node x2 $! u1 r2 h1) l2++-- | A singleton heap.+{-# INLINE singleton #-}+singleton :: a -> Heap a+singleton !x = Heap 1 (Node x Nil Nil)++-- | The empty heap.+{-# INLINE empty #-}+empty :: Heap a+empty = Heap 0 Nil++-- | Insert an element.+{-# INLINEABLE insert #-}+insert :: Ord a => a -> Heap a -> Heap a+insert x h = union (singleton x) h++-- | Find and remove the minimum element.+{-# INLINEABLE removeMin #-}+removeMin :: Ord a => Heap a -> Maybe (a, Heap a)+removeMin (Heap _ Nil) = Nothing+removeMin (Heap n (Node x l r)) = Just (x, Heap (n-1) (union1 l r))++-- | Map a function over a heap, removing all values which+-- map to 'Nothing'. May be more efficient when the function+-- being mapped is mostly monotonic.+{-# INLINEABLE mapMaybe #-}+mapMaybe :: Ord b => (a -> Maybe b) -> Heap a -> Heap b+mapMaybe f (Heap _ h) = Heap (sz 0 h') h'+  where+    -- Compute the size fairly efficiently.+    sz !n Nil = n+    sz !n (Node _ l r) = sz (sz (n+1) l) r++    h' = mm h++    mm Nil = Nil+    mm (Node x l r) =+      case f x of+        -- If the value maps to Nothing, get rid of it.+        Nothing -> union1 l' r'+        -- Otherwise, check if the heap invariant still holds+        -- and sift downwards to restore it.+        Just !y -> down y l' r'+      where+        !l' = mm l+        !r' = mm r++    down x l@(Node y ll lr) r@(Node z rl rr)+      -- Put the smallest of x, y and z at the root.+      | y < x && y <= z =+        (Node y $! down x ll lr) r+      | z < x && z <= y =+        Node z l $! down x rl rr+    down x Nil (Node y l r)+      -- Put the smallest of x and y at the root.+      | y < x =+        Node y Nil $! down x l r+    down x (Node y l r) Nil+      -- Put the smallest of x and y at the root.+      | y < x =+        (Node y $! down x l r) Nil+    down x l r = Node x l r++-- | Return the number of elements in the heap.+{-# INLINE size #-}+size :: Heap a -> Int+size (Heap n _) = n++-- Testing code:+-- import Test.QuickCheck+-- import qualified Data.List as List+-- import qualified Data.Maybe as Maybe++-- instance (Arbitrary a, Ord a) => Arbitrary (Heap a) where+--   arbitrary = sized arb+--     where+--       arb 0 = return empty+--       arb n =+--         frequency+--           [(1, singleton <$> arbitrary),+--            (n-1, union <$> arb' <*> arb')]+--         where+--           arb' = arb (n `div` 2)++-- toList :: Ord a => Heap a -> [a]+-- toList = List.unfoldr removeMin++-- invariant :: Ord a => Heap a -> Bool+-- invariant h@(Heap n h1) =+--   n == length (toList h) && ord h1+--   where+--     ord Nil = True+--     ord (Node x l r) = ord1 x l && ord1 x r++--     ord1 _ Nil = True+--     ord1 x h@(Node y _ _) = x <= y && ord h++-- prop_1 h = withMaxSuccess 10000 $ invariant h+-- prop_2 x h = withMaxSuccess 10000 $ invariant (insert x h)+-- prop_3 h =+--   withMaxSuccess 1000 $+--   case removeMin h of+--     Nothing -> discard+--     Just (_, h) -> invariant h+-- prop_4 h = withMaxSuccess 10000 $ List.sort (toList h) == toList h+-- prop_5 x h = withMaxSuccess 10000 $ toList (insert x h) == List.insert x (toList h)+-- prop_6 x h =+--   withMaxSuccess 1000 $+--   case removeMin h of+--     Nothing -> discard+--     Just (x, h') -> toList h == List.insert x (toList h')+-- prop_7 h1 h2 = withMaxSuccess 10000 $+--   invariant (union h1 h2)+-- prop_8 h1 h2 = withMaxSuccess 10000 $+--   toList (union h1 h2) == List.sort (toList h1 ++ toList h2)+-- prop_9 (Blind f) h = withMaxSuccess 10000 $+--   invariant (mapMaybe f h)+-- prop_10 (Blind f) h = withMaxSuccess 1000000 $+--   toList (mapMaybe f h) == List.sort (Maybe.mapMaybe f (toList h))++-- return []+-- main = $quickCheckAll
+ Data/Primitive/ByteArray/Checked.hs view
@@ -0,0 +1,74 @@+-- | A bounds-checked version of 'Data.Primitive.ByteArray'.+-- See that module for documentation.++{-# LANGUAGE ScopedTypeVariables #-}+module Data.Primitive.ByteArray.Checked(+  module Data.Primitive.ByteArray,+  module Data.Primitive.ByteArray.Checked) where++import Control.Monad.Primitive+import qualified Data.Primitive.ByteArray as P+import Data.Primitive(Prim)+import Data.Primitive.ByteArray(+  ByteArray(..), MutableByteArray(..),+  newByteArray, newPinnedByteArray, newAlignedPinnedByteArray,+  byteArrayContents, mutableByteArrayContents,+  sameMutableByteArray,+  unsafeFreezeByteArray, unsafeThawByteArray,+  sizeofByteArray, sizeofMutableByteArray)+import Data.Primitive.Checked+import Data.Word++instance Sized ByteArray where+  size = sizeofByteArray+instance Sized (MutableByteArray m) where+  size = sizeofMutableByteArray++{-# INLINE readByteArray #-}+readByteArray :: forall m a. (PrimMonad m, Prim a) => MutableByteArray (PrimState m) -> Int -> m a+readByteArray arr n =+  checkPrim (undefined :: a) arr n $+  P.readByteArray arr n++{-# INLINE writeByteArray #-}+writeByteArray :: (PrimMonad m, Prim a) => MutableByteArray (PrimState m) -> Int -> a -> m ()+writeByteArray arr n x =+  checkPrim x arr n $+  P.writeByteArray arr n x++{-# INLINE indexByteArray #-}+indexByteArray :: forall a. Prim a => ByteArray -> Int -> a+indexByteArray arr n =+  checkPrim (undefined :: a) arr n $+  P.indexByteArray arr n++{-# INLINE copyByteArray #-}+copyByteArray :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> ByteArray -> Int -> Int -> m ()+copyByteArray arr1 n1 arr2 n2 len =+  range arr1 n1 len $+  range arr2 n2 len $+  P.copyByteArray arr1 n1 arr2 n2 len++{-# INLINE moveByteArray #-}+moveByteArray :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()+moveByteArray arr1 n1 arr2 n2 len =+  range arr1 n1 len $+  range arr2 n2 len $+  P.moveByteArray arr1 n1 arr2 n2 len++{-# INLINE copyMutableByteArray #-}+copyMutableByteArray :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()+copyMutableByteArray arr1 n1 arr2 n2 len =+  range arr1 n1 len $+  range arr2 n2 len $+  P.copyMutableByteArray arr1 n1 arr2 n2 len++{-# INLINE setByteArray #-}+setByteArray :: (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()+setByteArray arr n len x =+  rangePrim x arr n len $+  P.setByteArray arr n len x++{-# INLINE fillByteArray #-}+fillByteArray :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> Int -> Word8 -> m ()+fillByteArray = setByteArray
+ Data/Primitive/Checked.hs view
@@ -0,0 +1,46 @@+-- | A helper module for array bounds checking.++module Data.Primitive.Checked where++import Data.Primitive(Prim, sizeOf)++-- | A type class of things which have a size (e.g., arrays).+class Sized a where+  -- | Read the size of the thing.+  size :: a -> Int++-- | Check that a single access is in bounds.+{-# INLINE check #-}+check :: Sized a => a -> Int -> b -> b+check arr n x+  | n >= 0 && n < size arr = x+  | otherwise = error "out-of-bounds array access"++-- | Check that a range of accesses is in bounds.+-- The range is inclusive.+{-# INLINE range #-}+range :: Sized a => a -> Int -> Int -> b -> b+range arr n len x+  | len < 0 = error "array slice has negative length"+  | len == 0 = x+  | otherwise =+    check arr n $+    check arr (n+len-1) $ x++-- | Check that a single access is in bounds.+-- The index accessed is computed by multiplying by the size+-- of the first argument.+{-# INLINE checkPrim #-}+checkPrim :: (Sized a, Prim b) => b -> a -> Int -> c -> c+checkPrim x arr n res =+  range arr (n*sizeOf x) (sizeOf x) res+  +-- | Check that a range of accesses is in bounds.+-- The range is inclusive.+-- The index accessed is computed by multiplying by the size+-- of the first argument.+{-# INLINE rangePrim #-}+rangePrim :: (Sized a, Prim b) => b -> a -> Int -> Int -> c -> c+rangePrim x arr n len res =+  range arr (n*sizeOf x) (len*sizeOf x) res+
+ Data/Primitive/SmallArray/Checked.hs view
@@ -0,0 +1,80 @@+-- | A bounds-checked version of 'Data.Primitive.SmallArray'.+-- See that module for documentation.++module Data.Primitive.SmallArray.Checked(+  module Data.Primitive.SmallArray,+  module Data.Primitive.SmallArray.Checked) where++import Control.Monad.Primitive+import qualified Data.Primitive.SmallArray as P+import Data.Primitive.SmallArray(+  SmallArray(..), SmallMutableArray(..), newSmallArray, unsafeFreezeSmallArray,+  unsafeThawSmallArray, sizeofSmallArray, sizeofSmallMutableArray)+import Data.Primitive.Checked++instance Sized (SmallArray a) where+  size = sizeofSmallArray+instance Sized (SmallMutableArray m a) where+  size = sizeofSmallMutableArray++{-# INLINE readSmallArray #-}+readSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> m a+readSmallArray arr n =+  check arr n $+  P.readSmallArray arr n++{-# INLINE writeSmallArray #-}+writeSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> a -> m ()+writeSmallArray arr n x =+  check arr n $+  P.writeSmallArray arr n x++{-# INLINE indexSmallArrayM #-}+indexSmallArrayM :: Monad m => SmallArray a -> Int -> m a+indexSmallArrayM arr n =+  check arr n $+  P.indexSmallArrayM arr n++{-# INLINE indexSmallArray #-}+indexSmallArray :: SmallArray a -> Int -> a+indexSmallArray arr n =+  check arr n $+  P.indexSmallArray arr n++{-# INLINE cloneSmallArray #-}+cloneSmallArray :: SmallArray a -> Int -> Int -> SmallArray a+cloneSmallArray arr n len =+  range arr n len $+  P.cloneSmallArray arr n len++{-# INLINE cloneSmallMutableArray #-}+cloneSmallMutableArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)+cloneSmallMutableArray arr n len =+  range arr n len $+  P.cloneSmallMutableArray arr n len++{-# INLINE freezeSmallArray #-}+freezeSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> Int -> m (SmallArray a)+freezeSmallArray arr n len =+  range arr n len $+  P.freezeSmallArray arr n len++{-# INLINE thawSmallArray #-}+thawSmallArray :: PrimMonad m => SmallArray a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)+thawSmallArray arr n len =+  range arr n len $+  P.thawSmallArray arr n len++{-# INLINE copySmallArray #-}+copySmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> SmallArray a -> Int -> Int -> m ()+copySmallArray arr1 n1 arr2 n2 len =+  range arr1 n1 len $+  range arr2 n2 len $+  P.copySmallArray arr1 n1 arr2 n2 len++{-# INLINE copySmallMutableArray #-}+copySmallMutableArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()+copySmallMutableArray arr1 n1 arr2 n2 len =+  range arr1 n1 len $+  range arr2 n2 len $+  P.copySmallMutableArray arr1 n1 arr2 n2 len
− README.md 
@@ -1,25 +0,0 @@-This is twee, an equational theorem prover.--The version in this git repository is likely to be unstable!-To install the latest stable version, run:--    cabal install twee--If you have LLVM installed, you can get a slightly faster version by-running:--    cabal install twee -fllvm--If you really want the latest unstable version, run `cabal install` in-this repository, and then in the `executable` subdirectory.-You will most likely need the latest git version of Jukebox, from-https://github.com/nick8325/jukebox, too - and things may break from-time to time.--Afterwards, run `twee nameofproblem.p`. The problem should be in TPTP-format (http://www.tptp.org). You can find a few examples in the-`tests` directory. All axioms and conjectures must be equations, but-you can freely use quantifiers. If it succeeds in proving your-problem, twee will print a human-readable proof.--For the official manual, see http://nick8325.github.io/twee.
+ Twee.hs view
@@ -0,0 +1,616 @@+-- | The main prover loop.+{-# LANGUAGE RecordWildCards, MultiParamTypeClasses, GADTs, BangPatterns, OverloadedStrings, ScopedTypeVariables, GeneralizedNewtypeDeriving, PatternGuards, TypeFamilies #-}+module Twee where++import Twee.Base+import Twee.Rule hiding (normalForms)+import qualified Twee.Rule as Rule+import Twee.Equation+import qualified Twee.Proof as Proof+import Twee.Proof(Proof, Axiom(..), Lemma(..), ProvedGoal(..), provedGoal, certify, derivation, symm)+import Twee.CP hiding (Config)+import qualified Twee.CP as CP+import Twee.Join hiding (Config, defaultConfig)+import qualified Twee.Join as Join+import qualified Twee.Rule.Index as RuleIndex+import Twee.Rule.Index(RuleIndex(..))+import qualified Twee.Index as Index+import Twee.Index(Index)+import Twee.Constraints+import Twee.Utils+import Twee.Task+import qualified Twee.PassiveQueue as Queue+import Twee.PassiveQueue(Queue, Passive(..))+import qualified Data.IntMap.Strict as IntMap+import Data.IntMap(IntMap)+import Data.Maybe+import Data.List+import Data.Function+import qualified Data.Set as Set+import Data.Set(Set)+import Data.Int+import Data.Ord+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import qualified Control.Monad.Trans.State.Strict as StateM++----------------------------------------------------------------------+-- * Configuration and prover state.+----------------------------------------------------------------------++-- | The prover configuration.+data Config =+  Config {+    cfg_max_term_size          :: Int,+    cfg_max_critical_pairs     :: Int64,+    cfg_max_cp_depth           :: Int,+    cfg_simplify               :: Bool,+    cfg_renormalise_percent    :: Int,+    cfg_critical_pairs         :: CP.Config,+    cfg_join                   :: Join.Config,+    cfg_proof_presentation     :: Proof.Config }++-- | The prover state.+data State f =+  State {+    st_rules          :: !(RuleIndex f (ActiveRule f)),+    st_active_ids     :: !(IntMap (Active f)),+    st_rule_ids       :: !(IntMap (ActiveRule f)),+    st_joinable       :: !(Index f (Equation f)),+    st_goals          :: ![Goal f],+    st_queue          :: !(Queue Params),+    st_next_active    :: {-# UNPACK #-} !Id,+    st_next_rule      :: {-# UNPACK #-} !RuleId,+    st_considered     :: {-# UNPACK #-} !Int64,+    st_messages_rev   :: ![Message f] }++-- | The default prover configuration.+defaultConfig :: Config+defaultConfig =+  Config {+    cfg_max_term_size = maxBound,+    cfg_max_critical_pairs = maxBound,+    cfg_max_cp_depth = maxBound,+    cfg_simplify = True,+    cfg_renormalise_percent = 5,+    cfg_critical_pairs = CP.defaultConfig,+    cfg_join = Join.defaultConfig,+    cfg_proof_presentation = Proof.defaultConfig }++-- | Does this configuration run the prover in a complete mode?+configIsComplete :: Config -> Bool+configIsComplete Config{..} =+  cfg_max_term_size == maxBound &&+  cfg_max_critical_pairs == maxBound &&+  cfg_max_cp_depth == maxBound++-- | The initial state.+initialState :: State f+initialState =+  State {+    st_rules = RuleIndex.empty,+    st_active_ids = IntMap.empty,+    st_rule_ids = IntMap.empty,+    st_joinable = Index.empty,+    st_goals = [],+    st_queue = Queue.empty,+    st_next_active = 1,+    st_next_rule = 0,+    st_considered = 0,+    st_messages_rev = [] }++----------------------------------------------------------------------+-- * Messages.+----------------------------------------------------------------------++-- | A message which is produced by the prover when something interesting happens.+data Message f =+    -- | A new rule.+    NewActive !(Active f)+    -- | A new joinable equation.+  | NewEquation !(Equation f)+    -- | A rule was deleted.+  | DeleteActive !(Active f)+    -- | The CP queue was simplified.+  | SimplifyQueue+    -- | The rules were reduced wrt each other.+  | Interreduce++instance Function f => Pretty (Message f) where+  pPrint (NewActive rule) = pPrint rule+  pPrint (NewEquation eqn) =+    text "  (hard)" <+> pPrint eqn+  pPrint (DeleteActive rule) =+    text "  (delete rule " <> pPrint (active_id rule) <> text ")"+  pPrint SimplifyQueue =+    text "  (simplifying queued critical pairs...)"+  pPrint Interreduce =+    text "  (simplifying rules with respect to one another...)"++-- | Emit a message.+message :: PrettyTerm f => Message f -> State f -> State f+message !msg state@State{..} =+  state { st_messages_rev = msg:st_messages_rev }++-- | Forget about all emitted messages.+clearMessages :: State f -> State f+clearMessages state@State{..} =+  state { st_messages_rev = [] }++-- | Get all emitted messages.+messages :: State f -> [Message f]+messages state = reverse (st_messages_rev state)++----------------------------------------------------------------------+-- * The CP queue.+----------------------------------------------------------------------++data Params+instance Queue.Params Params where+  type Score Params = Int+  type Id Params = RuleId+  type PackedId Params = Int32+  type PackedScore Params = Int32+  packScore _ = fromIntegral+  unpackScore _ = fromIntegral+  packId _ = fromIntegral+  unpackId _ = fromIntegral++-- | Compute all critical pairs from a rule.+{-# INLINEABLE makePassives #-}+makePassives :: Function f => Config -> State f -> ActiveRule f -> [Passive Params]+makePassives Config{..} State{..} rule =+  {-# SCC makePassive #-}+  [ Passive (fromIntegral (score cfg_critical_pairs o)) (rule_rid rule1) (rule_rid rule2) (fromIntegral (overlap_pos o))+  | (rule1, rule2, o) <- overlaps (Depth cfg_max_cp_depth) (index_oriented st_rules) rules rule ]+  where+    rules = IntMap.elems st_rule_ids++-- | Turn a Passive back into an overlap.+-- Doesn't try to simplify it.+{-# INLINEABLE findPassive #-}+findPassive :: forall f. Function f => Config -> State f -> Passive Params -> Maybe (ActiveRule f, ActiveRule f, Overlap f)+findPassive Config{..} State{..} Passive{..} = {-# SCC findPassive #-} do+  rule1 <- IntMap.lookup (fromIntegral passive_rule1) st_rule_ids+  rule2 <- IntMap.lookup (fromIntegral passive_rule2) st_rule_ids+  let !depth = 1 + max (the rule1) (the rule2)+  overlap <-+    overlapAt (fromIntegral passive_pos) depth+      (renameAvoiding (the rule2 :: Rule f) (the rule1)) (the rule2)+  return (rule1, rule2, overlap)++-- | Renormalise a queued Passive.+{-# INLINEABLE simplifyPassive #-}+simplifyPassive :: Function f => Config -> State f -> Passive Params -> Maybe (Passive Params)+simplifyPassive config@Config{..} state@State{..} passive = {-# SCC simplifyPassive #-} do+  (_, _, overlap) <- findPassive config state passive+  overlap <- simplifyOverlap (index_oriented st_rules) overlap+  return passive {+    passive_score = fromIntegral $+      fromIntegral (passive_score passive) `intMin`+      score cfg_critical_pairs overlap }++-- | Renormalise the entire queue.+{-# INLINEABLE simplifyQueue #-}+simplifyQueue :: Function f => Config -> State f -> State f+simplifyQueue config state =+  {-# SCC simplifyQueue #-}+  state { st_queue = simp (st_queue state) }+  where+    simp =+      Queue.mapMaybe (simplifyPassive config state)++-- | Enqueue a set of critical pairs.+{-# INLINEABLE enqueue #-}+enqueue :: Function f => State f -> RuleId -> [Passive Params] -> State f+enqueue state rule passives =+  {-# SCC enqueue #-}+  state { st_queue = Queue.insert rule passives (st_queue state) }++-- | Dequeue a critical pair.+--+-- Also takes care of:+--+--   * removing any orphans from the head of the queue+--   * ignoring CPs that are too big+{-# INLINEABLE dequeue #-}+dequeue :: Function f => Config -> State f -> (Maybe (CriticalPair f, ActiveRule f, ActiveRule f), State f)+dequeue config@Config{..} state@State{..} =+  {-# SCC dequeue #-}+  case deq 0 st_queue of+    -- Explicitly make the queue empty, in case it e.g. contained a+    -- lot of orphans+    Nothing -> (Nothing, state { st_queue = Queue.empty })+    Just (overlap, n, queue) ->+      (Just overlap,+       state { st_queue = queue, st_considered = st_considered + n })+  where+    deq !n queue = do+      (passive, queue) <- Queue.removeMin queue+      case findPassive config state passive of+        Just (rule1, rule2, overlap)+          | passive_score passive >= 0,+            Just Overlap{overlap_eqn = t :=: u} <-+              simplifyOverlap (index_oriented st_rules) overlap,+            size t <= cfg_max_term_size,+            size u <= cfg_max_term_size,+            Just cp <- makeCriticalPair rule1 rule2 overlap ->+              return ((cp, rule1, rule2), n+1, queue)+        _ -> deq (n+1) queue++----------------------------------------------------------------------+-- * Active rewrite rules.+----------------------------------------------------------------------++data Active f =+  Active {+    active_id    :: {-# UNPACK #-} !Id,+    active_depth :: {-# UNPACK #-} !Depth,+    active_rule  :: {-# UNPACK #-} !(Rule f),+    active_top   :: !(Maybe (Term f)),+    active_proof :: {-# UNPACK #-} !(Proof f),+    -- A model in which the rule is false (used when reorienting)+    active_model :: !(Model f),+    active_rules :: ![ActiveRule f] }++active_cp :: Active f -> CriticalPair f+active_cp Active{..} =+  CriticalPair {+    cp_eqn = unorient active_rule,+    cp_depth = active_depth,+    cp_top = active_top,+    cp_proof = derivation active_proof }++-- An active oriented in a particular direction.+data ActiveRule f =+  ActiveRule {+    rule_active    :: {-# UNPACK #-} !Id,+    rule_rid       :: {-# UNPACK #-} !RuleId,+    rule_depth     :: {-# UNPACK #-} !Depth,+    rule_rule      :: {-# UNPACK #-} !(Rule f),+    rule_proof     :: {-# UNPACK #-} !(Proof f),+    rule_positions :: !(Positions f) }++instance PrettyTerm f => Symbolic (ActiveRule f) where+  type ConstantOf (ActiveRule f) = f+  termsDL ActiveRule{..} =+    termsDL rule_rule `mplus`+    termsDL (derivation rule_proof)+  subst_ sub r@ActiveRule{..} =+    r {+      rule_rule = rule',+      rule_proof = certify (subst_ sub (derivation rule_proof)),+      rule_positions = positions (lhs rule') }+    where+      rule' = subst_ sub rule_rule++instance Eq (Active f) where+  (==) = (==) `on` active_id++instance Eq (ActiveRule f) where+  (==) = (==) `on` rule_rid++instance Function f => Pretty (Active f) where+  pPrint Active{..} =+    pPrint active_id <> text "." <+> pPrint (canonicalise active_rule)++instance Has (ActiveRule f) Id where the = rule_active+instance Has (ActiveRule f) RuleId where the = rule_rid+instance Has (ActiveRule f) Depth where the = rule_depth+instance f ~ g => Has (ActiveRule f) (Rule g) where the = rule_rule+instance f ~ g => Has (ActiveRule f) (Proof g) where the = rule_proof+instance f ~ g => Has (ActiveRule f) (Lemma g) where the x = Lemma (the x) (the x)+instance f ~ g => Has (ActiveRule f) (Positions g) where the = rule_positions++newtype RuleId = RuleId Id deriving (Eq, Ord, Show, Num, Real, Integral, Enum)++-- Add a new active.+{-# INLINEABLE addActive #-}+addActive :: Function f => Config -> State f -> (Id -> RuleId -> RuleId -> Active f) -> State f+addActive config state@State{..} active0 =+  {-# SCC addActive #-}+  let+    active@Active{..} = active0 st_next_active st_next_rule (succ st_next_rule)+    state' =+      message (NewActive active) $+      addActiveOnly state{st_next_active = st_next_active+1, st_next_rule = st_next_rule+2} active+  in if subsumed st_joinable st_rules (unorient active_rule) then+    state+  else+    normaliseGoals $+    foldl' (uncurry . enqueue) state'+      [ (the rule, makePassives config state' rule)+      | rule <- active_rules ]++-- Add an active without generating critical pairs. Used in interreduction.+{-# INLINEABLE addActiveOnly #-}+addActiveOnly :: Function f => State f -> Active f -> State f+addActiveOnly state@State{..} active@Active{..} =+  state {+    st_rules = foldl' insertRule st_rules active_rules,+    st_active_ids = IntMap.insert (fromIntegral active_id) active st_active_ids,+    st_rule_ids = foldl' insertRuleId st_rule_ids active_rules }+  where+    insertRule rules rule@ActiveRule{..} =+      RuleIndex.insert (lhs rule_rule) rule rules+    insertRuleId rules rule@ActiveRule{..} =+      IntMap.insert (fromIntegral rule_rid) rule rules++-- Delete an active. Used in interreduction, not suitable for general use.+{-# INLINE deleteActive #-}+deleteActive :: Function f => State f -> Active f -> State f+deleteActive state@State{..} Active{..} =+  state {+    st_rules = foldl' deleteRule st_rules active_rules,+    st_active_ids = IntMap.delete (fromIntegral active_id) st_active_ids,+    st_rule_ids = foldl' deleteRuleId st_rule_ids active_rules }+  where+    deleteRule rules rule =+      RuleIndex.delete (lhs (rule_rule rule)) rule rules+    deleteRuleId rules ActiveRule{..} =+      IntMap.delete (fromIntegral rule_rid) rules++-- Try to join a critical pair.+{-# INLINEABLE consider #-}+consider :: Function f => Config -> State f -> CriticalPair f -> State f+consider config state cp =+  considerUsing (st_rules state) config state cp++-- Try to join a critical pair, but using a different set of critical+-- pairs for normalisation.+{-# INLINEABLE considerUsing #-}+considerUsing ::+  Function f =>+  RuleIndex f (ActiveRule f) -> Config -> State f -> CriticalPair f -> State f+considerUsing rules config@Config{..} state@State{..} cp0 =+  {-# SCC consider #-}+  -- Important to canonicalise the rule so that we don't get+  -- bigger and bigger variable indices over time+  let cp = canonicalise cp0 in+  case joinCriticalPair cfg_join st_joinable rules Nothing cp of+    Right (mcp, cps) ->+      let+        state' = foldl' (considerUsing rules config) state cps+      in case mcp of+        Just cp -> addJoinable state' (cp_eqn cp)+        Nothing -> state'++    Left (cp, model) ->+      foldl' (addCP config model) state (split cp)++{-# INLINEABLE addCP #-}+addCP :: Function f => Config -> Model f -> State f -> CriticalPair f -> State f+addCP config model state@State{..} CriticalPair{..} =+  addActive config state $ \n k1 k2 ->+  let+    pf = certify cp_proof+    rule = orient cp_eqn++    makeRule k r p =+      ActiveRule {+        rule_active = n,+        rule_rid = k,+        rule_depth = cp_depth,+        rule_rule = r rule,+        rule_proof = p pf,+        rule_positions = positions (lhs (r rule)) }+  in+  Active {+    active_id = n,+    active_depth = cp_depth,+    active_rule = rule,+    active_model = model,+    active_top = cp_top,+    active_proof = pf,+    active_rules =+      usortBy (comparing (canonicalise . rule_rule)) $+        makeRule k1 id id:+        [ makeRule k2 backwards (certify . symm . derivation)+        | not (oriented (orientation rule)) ] }++-- Add a new equation.+{-# INLINEABLE addAxiom #-}+addAxiom :: Function f => Config -> State f -> Axiom f -> State f+addAxiom config state axiom =+  consider config state $+    CriticalPair {+      cp_eqn = axiom_eqn axiom,+      cp_depth = 0,+      cp_top = Nothing,+      cp_proof = Proof.axiom axiom }++-- Record an equation as being joinable.+{-# INLINEABLE addJoinable #-}+addJoinable :: Function f => State f -> Equation f -> State f+addJoinable state eqn@(t :=: u) =+  message (NewEquation eqn) $+  state {+    st_joinable =+      Index.insert t (t :=: u) $+      Index.insert u (u :=: t) (st_joinable state) }++-- For goal terms we store the set of all their normal forms.+-- Name and number are for information only.+data Goal f =+  Goal {+    goal_name   :: String,+    goal_number :: Int,+    goal_eqn    :: Equation f,+    goal_lhs    :: Set (Resulting f),+    goal_rhs    :: Set (Resulting f) }++-- Add a new goal.+{-# INLINEABLE addGoal #-}+addGoal :: Function f => Config -> State f -> Goal f -> State f+addGoal _config state@State{..} goal =+  normaliseGoals state { st_goals = goal:st_goals }++-- Normalise all goals.+{-# INLINEABLE normaliseGoals #-}+normaliseGoals :: Function f => State f -> State f+normaliseGoals state@State{..} =+  {-# SCC normaliseGoals #-}+  state {+    st_goals =+      map (goalMap (successors (rewrite reduces (index_all st_rules)) . Set.toList)) st_goals }+  where+    goalMap f goal@Goal{..} =+      goal { goal_lhs = f goal_lhs, goal_rhs = f goal_rhs }++-- Create a goal.+{-# INLINE goal #-}+goal :: Int -> String -> Equation f -> Goal f+goal n name (t :=: u) =+  Goal {+    goal_name = name,+    goal_number = n,+    goal_eqn = t :=: u,+    goal_lhs = Set.singleton (reduce (Refl t)),+    goal_rhs = Set.singleton (reduce (Refl u)) }++----------------------------------------------------------------------+-- Interreduction.+----------------------------------------------------------------------++-- Simplify all rules.+{-# INLINEABLE interreduce #-}+interreduce :: Function f => Config -> State f -> State f+interreduce config@Config{..} state =+  {-# SCC interreduce #-}+  let+    state' =+      foldl' (interreduce1 config)+        -- Clear out st_joinable, since we don't know which+        -- equations have made use of each active.+        state { st_joinable = Index.empty }+        (IntMap.elems (st_active_ids state))+    in state' { st_joinable = st_joinable state }++{-# INLINEABLE interreduce1 #-}+interreduce1 :: Function f => Config -> State f -> Active f -> State f+interreduce1 config@Config{..} state active =+  -- Exclude the active from the rewrite rules when testing+  -- joinability, otherwise it will be trivially joinable.+  case+    joinCriticalPair cfg_join+      (st_joinable state)+      (st_rules (deleteActive state active))+      (Just (active_model active)) (active_cp active)+  of+    Right (_, cps) ->+      flip (foldl' (consider config)) cps $+      message (DeleteActive active) $+      deleteActive state active+    Left (cp, model)+      | not (cp_eqn cp `isInstanceOf` cp_eqn (active_cp active)) ->+        flip (foldl' (addCP config model)) (split cp) $+        message (DeleteActive active) $+        deleteActive state active+      | model /= active_model active ->+        flip addActiveOnly active { active_model = model } $+        deleteActive state active+      | otherwise ->+        state+  where+    (t :=: u) `isInstanceOf` (t' :=: u') = isJust $ do+      sub <- match t' t+      matchIn sub u' u+++----------------------------------------------------------------------+-- The main loop.+----------------------------------------------------------------------++data Output m f =+  Output {+    output_message :: Message f -> m () }++{-# INLINE complete #-}+complete :: (Function f, MonadIO m) => Output m f -> Config -> State f -> m (State f)+complete Output{..} config@Config{..} state =+  flip StateM.execStateT state $ do+    tasks <- sequence+      [newTask 1 (fromIntegral cfg_renormalise_percent / 100) $ do+         lift $ output_message SimplifyQueue+         state <- StateM.get+         StateM.put $! simplifyQueue config state,+       newTask 0.25 0.05 $ do+         when cfg_simplify $ do+           lift $ output_message Interreduce+           state <- StateM.get+           StateM.put $! interreduce config state]++    let+      loop = do+        progress <- StateM.state (complete1 config)+        state <- StateM.get+        lift $ mapM_ output_message (messages state)+        StateM.put (clearMessages state)+        mapM_ checkTask tasks+        when progress loop++    loop++{-# INLINEABLE complete1 #-}+complete1 :: Function f => Config -> State f -> (Bool, State f)+complete1 config@Config{..} state+  | st_considered state >= cfg_max_critical_pairs =+    (False, state)+  | solved state = (False, state)+  | otherwise =+    case dequeue config state of+      (Nothing, state) -> (False, state)+      (Just (overlap, _, _), state) ->+        (True, consider config state overlap)++{-# INLINEABLE solved #-}+solved :: Function f => State f -> Bool+solved = not . null . solutions++-- Return whatever goals we have proved and their proofs.+{-# INLINEABLE solutions #-}+solutions :: Function f => State f -> [ProvedGoal f]+solutions State{..} = {-# SCC solutions #-} do+  Goal{goal_lhs = ts, goal_rhs = us, ..} <- st_goals+  guard (not (null (Set.intersection ts us)))+  let t:_ = filter (`Set.member` us) (Set.toList ts)+      u:_ = filter (== t) (Set.toList us)+      -- Strict so that we check the proof before returning a solution+      !p =+        Proof.certify $+          reductionProof (reduction t) `Proof.trans`+          Proof.symm (reductionProof (reduction u))+  return (provedGoal goal_number goal_name p)++-- Return all current rewrite rules.+{-# INLINEABLE rules #-}+rules :: Function f => State f -> [Rule f]+rules = map active_rule . IntMap.elems . st_active_ids++----------------------------------------------------------------------+-- For code which uses twee as a library.+----------------------------------------------------------------------++{-# INLINEABLE completePure #-}+completePure :: Function f => Config -> State f -> State f+completePure cfg state+  | progress = completePure cfg (clearMessages state')+  | otherwise = state'+  where+    (progress, state') = complete1 cfg state++{-# INLINEABLE normaliseTerm #-}+normaliseTerm :: Function f => State f -> Term f -> Resulting f+normaliseTerm State{..} t =+  normaliseWith (const True) (rewrite reduces (index_all st_rules)) t++{-# INLINEABLE normalForms #-}+normalForms :: Function f => State f -> Term f -> Set (Resulting f)+normalForms State{..} t =+  Rule.normalForms (rewrite reduces (index_all st_rules)) [reduce (Refl t)]++{-# INLINEABLE simplifyTerm #-}+simplifyTerm :: Function f => State f -> Term f -> Term f+simplifyTerm State{..} t =+  simplify (index_oriented st_rules) t
+ Twee/Base.hs view
@@ -0,0 +1,285 @@+-- | Useful operations on terms and similar. Also re-exports some generally+-- useful modules such as 'Twee.Term' and 'Twee.Pretty'.++{-# LANGUAGE TypeFamilies, FlexibleInstances, UndecidableInstances, DeriveFunctor, DefaultSignatures, FlexibleContexts, TypeOperators, MultiParamTypeClasses, GeneralizedNewtypeDeriving, ConstraintKinds, RecordWildCards #-}+module Twee.Base(+  -- * Re-exported functionality+  module Twee.Term, module Twee.Pretty,+  -- * The 'Symbolic' typeclass+  Symbolic(..), subst, terms,+  TermOf, TermListOf, SubstOf, TriangleSubstOf, BuilderOf, FunOf,+  vars, isGround, funs, occ, occVar, canonicalise, renameAvoiding,+  -- * General-purpose functionality+  Id(..), Has(..),+  -- * Typeclasses+  Minimal(..), minimalTerm, isMinimal, erase,+  Skolem(..), Arity(..), Sized(..), Ordered(..), lessThan, orientTerms, EqualsBonus(..), Strictness(..), Function, Extended(..)) where++import Prelude hiding (lookup)+import Control.Monad+import qualified Data.DList as DList+import Twee.Term hiding (subst, canonicalise)+import qualified Twee.Term as Term+import Twee.Pretty+import Twee.Constraints hiding (funs)+import Data.DList(DList)+import Data.Typeable+import Data.Int+import Data.Maybe+import qualified Data.IntMap.Strict as IntMap++-- | Represents a unique identifier (e.g., for a rule).+newtype Id = Id { unId :: Int32 }+  deriving (Eq, Ord, Show, Enum, Bounded, Num, Real, Integral)++instance Pretty Id where+  pPrint = text . show . unId++-- | Generalisation of term functionality to things that contain terms (e.g.,+-- rewrite rules and equations).+class Symbolic a where+  type ConstantOf a++  -- | Compute a 'DList' of all terms which appear in the argument+  -- (used for e.g. computing free variables).+  -- See also 'terms'.+  termsDL :: a -> DList (TermListOf a)++  -- | Apply a substitution.+  -- When using the 'Symbolic' type class, you can use 'subst' instead.+  subst_ :: (Var -> BuilderOf a) -> a -> a++-- | Apply a substitution.+subst :: (Symbolic a, Substitution s, SubstFun s ~ ConstantOf a) => s -> a -> a+subst sub x = subst_ (evalSubst sub) x++-- | Find all terms occuring in the argument.+terms :: Symbolic a => a -> [TermListOf a]+terms = DList.toList . termsDL++-- | A term compatible with a given 'Symbolic'.+type TermOf a = Term (ConstantOf a)+-- | A termlist compatible with a given 'Symbolic'.+type TermListOf a = TermList (ConstantOf a)+-- | A substitution compatible with a given 'Symbolic'.+type SubstOf a = Subst (ConstantOf a)+-- | A triangle substitution compatible with a given 'Symbolic'.+type TriangleSubstOf a = TriangleSubst (ConstantOf a)+-- | A builder compatible with a given 'Symbolic'.+type BuilderOf a = Builder (ConstantOf a)+-- | The underlying type of function symbols of a given 'Symbolic'.+type FunOf a = Fun (ConstantOf a)++instance Symbolic (Term f) where+  type ConstantOf (Term f) = f+  termsDL = return . singleton+  subst_ sub = build . Term.subst sub++instance Symbolic (TermList f) where+  type ConstantOf (TermList f) = f+  termsDL = return+  subst_ sub = buildList . Term.substList sub++instance Symbolic (Subst f) where+  type ConstantOf (Subst f) = f+  termsDL (Subst sub) = termsDL (IntMap.elems sub)+  subst_ sub (Subst s) = Subst (fmap (subst_ sub) s)++instance (ConstantOf a ~ ConstantOf b, Symbolic a, Symbolic b) => Symbolic (a, b) where+  type ConstantOf (a, b) = ConstantOf a+  termsDL (x, y) = termsDL x `mplus` termsDL y+  subst_ sub (x, y) = (subst_ sub x, subst_ sub y)++instance (ConstantOf a ~ ConstantOf b,+          ConstantOf a ~ ConstantOf c,+          Symbolic a, Symbolic b, Symbolic c) => Symbolic (a, b, c) where+  type ConstantOf (a, b, c) = ConstantOf a+  termsDL (x, y, z) = termsDL x `mplus` termsDL y `mplus` termsDL z+  subst_ sub (x, y, z) = (subst_ sub x, subst_ sub y, subst_ sub z)++instance Symbolic a => Symbolic [a] where+  type ConstantOf [a] = ConstantOf a+  termsDL xs = msum (map termsDL xs)+  subst_ sub xs = map (subst_ sub) xs++instance Symbolic a => Symbolic (Maybe a) where+  type ConstantOf (Maybe a) = ConstantOf a+  termsDL Nothing = mzero+  termsDL (Just x) = termsDL x+  subst_ sub x = fmap (subst_ sub) x++-- | An instance @'Has' a b@ indicates that a value of type @a@ contains a value+-- of type @b@ which is somehow part of the meaning of the @a@.+--+-- A number of functions use 'Has' constraints to work in a more general setting.+-- For example, the functions in 'Twee.CP' operate on rewrite rules, but actually+-- accept any @a@ satisfying @'Has' a ('Twee.Rule.Rule' f)@.+--+-- Use taste when definining 'Has' instances; don't do it willy-nilly.+class Has a b where+  -- | Get at the thing.+  the :: a -> b++instance Has a a where+  the = id++-- | Find the variables occurring in the argument.+{-# INLINE vars #-}+vars :: Symbolic a => a -> [Var]+vars x = [ v | t <- DList.toList (termsDL x), Var v <- subtermsList t ]++-- | Test if the argument is ground.+{-# INLINE isGround #-}+isGround :: Symbolic a => a -> Bool+isGround = null . vars++-- | Find the function symbols occurring in the argument.+{-# INLINE funs #-}+funs :: Symbolic a => a -> [FunOf a]+funs x = [ f | t <- DList.toList (termsDL x), App f _ <- subtermsList t ]++-- | Count how many times a function symbol occurs in the argument.+{-# INLINE occ #-}+occ :: Symbolic a => FunOf a -> a -> Int+occ x t = length (filter (== x) (funs t))++-- | Count how many times a variable occurs in the argument.+{-# INLINE occVar #-}+occVar :: Symbolic a => Var -> a -> Int+occVar x t = length (filter (== x) (vars t))++-- | Rename the argument so that variables are introduced in a canonical order+-- (starting with V0, then V1 and so on).+{-# INLINEABLE canonicalise #-}+canonicalise :: Symbolic a => a -> a+canonicalise t = subst sub t+  where+    sub = Term.canonicalise (DList.toList (termsDL t))++-- | Rename the second argument so that it does not mention any variable which+-- occurs in the first.+{-# INLINEABLE renameAvoiding #-}+renameAvoiding :: (Symbolic a, Symbolic b) => a -> b -> b+renameAvoiding x y+  | x2 < y1 || y2 < x1 =+    -- No overlap. Important in the case when x is ground,+    -- in which case x2 == minBound and the calculation below doesn't work.+    y+  | otherwise =+    -- Map y1 to x2+1+    subst (\(V x) -> var (V (x-y1+x2+1))) y+  where+    (V x1, V x2) = boundLists (terms x)+    (V y1, V y2) = boundLists (terms y)++-- | Check if a term is the minimal constant.+isMinimal :: Minimal f => Term f -> Bool+isMinimal (App f Empty) | f == minimal = True+isMinimal _ = False++-- | Build the minimal constant as a term.+minimalTerm :: Minimal f => Term f+minimalTerm = build (con minimal)++-- | Erase a given set of variables from the argument, replacing them with the+-- minimal constant.+erase :: (Symbolic a, ConstantOf a ~ f, Minimal f) => [Var] -> a -> a+erase [] t = t+erase xs t = subst sub t+  where+    sub = fromMaybe undefined $ listToSubst [(x, minimalTerm) | x <- xs]++-- | Construction of Skolem constants.+class Skolem f where+  -- | Turn a variable into a Skolem constant.+  skolem  :: Var -> Fun f++-- | For types which have a notion of arity.+class Arity f where+  -- | Measure the arity.+  arity :: f -> Int++instance Arity f => Arity (Fun f) where+  arity = arity . fun_value++-- | For types which have a notion of size.+class Sized a where+  -- | Compute the size.+  size  :: a -> Int++instance Sized f => Sized (Fun f) where+  size = size . fun_value++instance Sized f => Sized (TermList f) where+  size = aux 0+    where+      aux n Empty = n+      aux n (ConsSym (App f _) t) = aux (n+size f) t+      aux n (Cons (Var _) t) = aux (n+1) t++instance Sized f => Sized (Term f) where+  size = size . singleton++-- | The collection of constraints which the type of function symbols must+-- satisfy in order to be used by twee.+type Function f = (Ordered f, Arity f, Sized f, Minimal f, Skolem f, PrettyTerm f, EqualsBonus f)++-- | A hack for encoding Horn clauses. See 'Twee.CP.Score'.+-- The default implementation of 'hasEqualsBonus' should work OK.+class EqualsBonus f where+  hasEqualsBonus :: f -> Bool+  hasEqualsBonus _ = False+  isEquals, isTrue, isFalse :: f -> Bool+  isEquals _ = False+  isTrue _ = False+  isFalse _ = False++instance EqualsBonus f => EqualsBonus (Fun f) where+  hasEqualsBonus = hasEqualsBonus . fun_value+  isEquals = isEquals . fun_value+  isTrue = isTrue . fun_value+  isFalse = isFalse . fun_value++-- | A function symbol extended with a minimal constant and Skolem functions.+-- Comes equipped with 'Minimal' and 'Skolem' instances.+data Extended f =+    -- | The minimal constant.+    Minimal+    -- | A Skolem function.+  | Skolem Var+    -- | An ordinary function symbol.+  | Function f+  deriving (Eq, Ord, Show, Functor)++instance Pretty f => Pretty (Extended f) where+  pPrintPrec _ _ Minimal = text "?"+  pPrintPrec _ _ (Skolem (V n)) = text "sk" <> pPrint n+  pPrintPrec l p (Function f) = pPrintPrec l p f++instance PrettyTerm f => PrettyTerm (Extended f) where+  termStyle (Function f) = termStyle f+  termStyle _ = uncurried++instance Sized f => Sized (Extended f) where+  size (Function f) = size f+  size _ = 1++instance Arity f => Arity (Extended f) where+  arity (Function f) = arity f+  arity _ = 0++instance (Typeable f, Ord f) => Minimal (Extended f) where+  minimal = fun Minimal++instance (Typeable f, Ord f) => Skolem (Extended f) where+  skolem x = fun (Skolem x)++instance EqualsBonus f => EqualsBonus (Extended f) where+  hasEqualsBonus (Function f) = hasEqualsBonus f+  hasEqualsBonus _ = False+  isEquals (Function f) = isEquals f+  isEquals _ = False+  isTrue (Function f) = isTrue f+  isTrue _ = False+  isFalse (Function f) = isFalse f+  isFalse _ = False
+ Twee/CP.hs view
@@ -0,0 +1,330 @@+-- | Critical pair generation.+{-# LANGUAGE BangPatterns, FlexibleContexts, ScopedTypeVariables, MultiParamTypeClasses, RecordWildCards, OverloadedStrings, TypeFamilies, GeneralizedNewtypeDeriving #-}+module Twee.CP where++import qualified Twee.Term as Term+import Twee.Base+import Twee.Rule+import Twee.Index(Index)+import qualified Data.Set as Set+import Control.Monad+import Data.Maybe+import Data.List+import qualified Data.ChurchList as ChurchList+import Data.ChurchList (ChurchList(..))+import Twee.Utils+import Twee.Equation+import qualified Twee.Proof as Proof+import Twee.Proof(Derivation, Lemma, congPath)++-- | The set of positions at which a term can have critical overlaps.+data Positions f = NilP | ConsP {-# UNPACK #-} !Int !(Positions f)+type PositionsOf a = Positions (ConstantOf a)++instance Show (Positions f) where+  show = show . ChurchList.toList . positionsChurch++-- | Calculate the set of positions for a term.+positions :: Term f -> Positions f+positions t = aux 0 Set.empty (singleton t)+  where+    -- Consider only general superpositions.+    aux !_ !_ Empty = NilP+    aux n m (Cons (Var _) t) = aux (n+1) m t+    aux n m (ConsSym t@App{} u)+      | t `Set.member` m = aux (n+1) m u+      | otherwise = ConsP n (aux (n+1) (Set.insert t m) u)++{-# INLINE positionsChurch #-}+positionsChurch :: Positions f -> ChurchList Int+positionsChurch posns =+  ChurchList $ \c n ->+    let+      pos NilP = n+      pos (ConsP x posns) = c x (pos posns)+    in+      pos posns++-- | A critical overlap of one rule with another.+data Overlap f =+  Overlap {+    -- | The depth (1 for CPs of axioms, 2 for CPs whose rules have depth 1, etc.)+    overlap_depth :: {-# UNPACK #-} !Depth,+    -- | The critical term.+    overlap_top   :: {-# UNPACK #-} !(Term f),+    -- | The part of the critical term which the inner rule rewrites.+    overlap_inner :: {-# UNPACK #-} !(Term f),+    -- | The position in the critical term which is rewritten.+    overlap_pos   :: {-# UNPACK #-} !Int,+    -- | The critical pair itself.+    overlap_eqn   :: {-# UNPACK #-} !(Equation f) }+  deriving Show+type OverlapOf a = Overlap (ConstantOf a)++-- | Represents the depth of a critical pair.+newtype Depth = Depth Int deriving (Eq, Ord, Num, Real, Enum, Integral, Show)++-- | Compute all overlaps of a rule with a set of rules.+{-# INLINEABLE overlaps #-}+overlaps ::+  (Function f, Has a (Rule f), Has a (Positions f), Has a Depth) =>+  Depth -> Index f a -> [a] -> a -> [(a, a, Overlap f)]+overlaps max_depth idx rules r =+  ChurchList.toList (overlapsChurch max_depth idx rules r)++{-# INLINE overlapsChurch #-}+overlapsChurch :: forall f a.+  (Function f, Has a (Rule f), Has a (Positions f), Has a Depth) =>+  Depth -> Index f a -> [a] -> a -> ChurchList (a, a, Overlap f)+overlapsChurch max_depth idx rules r1 = do+  guard (the r1 < max_depth)+  r2 <- ChurchList.fromList rules+  guard (the r2 < max_depth)+  let !depth = 1 + max (the r1) (the r2)+  do { o <- asymmetricOverlaps idx depth (the r1) r1' (the r2); return (r1, r2, o) } `mplus`+    do { o <- asymmetricOverlaps idx depth (the r2) (the r2) r1'; return (r2, r1, o) }+  where+    !r1' = renameAvoiding (map the rules :: [Rule f]) (the r1)++{-# INLINE asymmetricOverlaps #-}+asymmetricOverlaps ::+  (Function f, Has a (Rule f), Has a Depth) =>+  Index f a -> Depth -> Positions f -> Rule f -> Rule f -> ChurchList (Overlap f)+asymmetricOverlaps idx depth posns r1 r2 = do+  n <- positionsChurch posns+  ChurchList.fromMaybe $+    overlapAt n depth r1 r2 >>=+    simplifyOverlap idx++-- | Create an overlap at a particular position in a term.+-- Doesn't simplify the overlap.+{-# INLINE overlapAt #-}+overlapAt :: Int -> Depth -> Rule f -> Rule f -> Maybe (Overlap f)+overlapAt !n !depth (Rule _ !outer !outer') (Rule _ !inner !inner') = do+  let t = at n (singleton outer)+  sub <- unifyTri inner t+  let+    top = {-# SCC overlap_top #-} termSubst sub outer+    innerTerm = {-# SCC overlap_inner #-} termSubst sub inner+    -- Make sure to keep in sync with overlapProof+    lhs = {-# SCC overlap_eqn_1 #-} termSubst sub outer'+    rhs = {-# SCC overlap_eqn_2 #-}+      buildReplacePositionSub sub n (singleton inner') (singleton outer)++  guard (lhs /= rhs)+  return Overlap {+    overlap_depth = depth,+    overlap_top = top,+    overlap_inner = innerTerm,+    overlap_pos = n,+    overlap_eqn = lhs :=: rhs }++-- | Simplify an overlap and remove it if it's trivial.+{-# INLINE simplifyOverlap #-}+simplifyOverlap :: (Function f, Has a (Rule f)) => Index f a -> Overlap f -> Maybe (Overlap f)+simplifyOverlap idx overlap@Overlap{overlap_eqn = lhs :=: rhs, ..}+  | lhs == rhs'  = Nothing+  | lhs' == rhs' = Nothing+  | otherwise = Just overlap{overlap_eqn = lhs' :=: rhs'}+  where+    lhs' = simplify idx lhs+    rhs' = simplify idx rhs++-- Put these in separate functions to avoid code blowup+buildReplacePositionSub :: TriangleSubst f -> Int -> TermList f -> TermList f -> Term f+buildReplacePositionSub !sub !n !inner' !outer =+  build (replacePositionSub sub n inner' outer)++termSubst :: TriangleSubst f -> Term f -> Term f+termSubst sub t = build (Term.subst sub t)++-- | The configuration for the critical pair weighting heuristic.+data Config =+  Config {+    cfg_lhsweight :: !Int,+    cfg_rhsweight :: !Int,+    cfg_funweight :: !Int,+    cfg_varweight :: !Int,+    cfg_depthweight :: !Int,+    cfg_dupcost :: !Int,+    cfg_dupfactor :: !Int }++-- | The default heuristic configuration.+defaultConfig :: Config+defaultConfig =+  Config {+    cfg_lhsweight = 3,+    cfg_rhsweight = 1,+    cfg_funweight = 7,+    cfg_varweight = 6,+    cfg_depthweight = 16,+    cfg_dupcost = 7,+    cfg_dupfactor = 0 }++-- | Compute a score for a critical pair.++-- We compute:+--   cfg_lhsweight * size l + cfg_rhsweight * size r+-- where l is the biggest term and r is the smallest,+-- and variables have weight 1 and functions have weight cfg_funweight.+{-# INLINEABLE score #-}+score :: Function f => Config -> Overlap f -> Int+score Config{..} Overlap{..} =+  fromIntegral overlap_depth * cfg_depthweight ++  (m + n) * cfg_rhsweight ++  intMax m n * (cfg_lhsweight - cfg_rhsweight)+  where+    l :=: r = overlap_eqn+    m = size' 0 (singleton l)+    n = size' 0 (singleton r)++    size' !n Empty = n+    size' n (Cons t ts)+      | len t > 1, t `isSubtermOfList` ts =+        size' (n+cfg_dupcost+cfg_dupfactor*size t) ts+    size' n ts+      | Cons (App f ws@(Cons a (Cons b us))) vs <- ts,+        hasEqualsBonus (fun_value f),+        Just sub <- unify a b =+        size' (n+cfg_funweight*size f) ws `min`+        size' (size' (n+1) (subst sub us)) (subst sub vs)+    size' n (Cons (Var _) ts) =+      size' (n+cfg_varweight) ts+    size' n (ConsSym (App f _) ts) =+      size' (n+cfg_funweight*size f) ts++----------------------------------------------------------------------+-- * Higher-level handling of critical pairs.+----------------------------------------------------------------------++-- | A critical pair together with information about how it was derived+data CriticalPair f =+  CriticalPair {+    -- | The critical pair itself.+    cp_eqn   :: {-# UNPACK #-} !(Equation f),+    -- | The depth of the critical pair.+    cp_depth :: {-# UNPACK #-} !Depth,+    -- | The critical term, if there is one.+    -- (Axioms do not have a critical term.)+    cp_top   :: !(Maybe (Term f)),+    -- | A derivation of the critical pair from the axioms.+    cp_proof :: !(Derivation f) }++instance Symbolic (CriticalPair f) where+  type ConstantOf (CriticalPair f) = f+  termsDL CriticalPair{..} =+    termsDL cp_eqn `mplus` termsDL cp_top `mplus` termsDL cp_proof+  subst_ sub CriticalPair{..} =+    CriticalPair {+      cp_eqn = subst_ sub cp_eqn,+      cp_depth = cp_depth,+      cp_top = subst_ sub cp_top,+      cp_proof = subst_ sub cp_proof }++instance PrettyTerm f => Pretty (CriticalPair f) where+  pPrint CriticalPair{..} =+    vcat [+      pPrint cp_eqn,+      nest 2 (text "top:" <+> pPrint cp_top) ]++-- | Split a critical pair so that it can be turned into rules.+--+-- The resulting critical pairs have the property that no variable appears on+-- the right that is not on the left.++-- See the comment below.+split :: Function f => CriticalPair f -> [CriticalPair f]+split CriticalPair{cp_eqn = l :=: r, ..}+  | l == r = []+  | otherwise =+    -- If we have something which is almost a rule, except that some+    -- variables appear only on the right-hand side, e.g.:+    --   f x y -> g x z+    -- then we replace it with the following two rules:+    --   f x y -> g x ?+    --   g x z -> g x ?+    -- where the second rule is weakly oriented and ? is the minimal+    -- constant.+    --+    -- If we have an unoriented equation with a similar problem, e.g.:+    --   f x y = g x z+    -- then we replace it with potentially three rules:+    --   f x ? = g x ?+    --   f x y -> f x ?+    --   g x z -> g x ?++    -- The main rule l -> r' or r -> l' or l' = r'+    [ CriticalPair {+        cp_eqn   = l :=: r',+        cp_depth = cp_depth,+        cp_top   = eraseExcept (vars l) cp_top,+        cp_proof = eraseExcept (vars l) cp_proof }+    | ord == Just GT ] +++    [ CriticalPair {+        cp_eqn   = r :=: l',+        cp_depth = cp_depth,+        cp_top   = eraseExcept (vars r) cp_top,+        cp_proof = Proof.symm (eraseExcept (vars r) cp_proof) }+    | ord == Just LT ] +++    [ CriticalPair {+        cp_eqn   = l' :=: r',+        cp_depth = cp_depth,+        cp_top   = eraseExcept (vars l) $ eraseExcept (vars r) cp_top,+        cp_proof = eraseExcept (vars l) $ eraseExcept (vars r) cp_proof }+    | ord == Nothing ] ++++    -- Weak rules l -> l' or r -> r'+    [ CriticalPair {+        cp_eqn   = l :=: l',+        cp_depth = cp_depth + 1,+        cp_top   = Nothing,+        cp_proof = cp_proof `Proof.trans` Proof.symm (erase ls cp_proof) }+    | not (null ls), ord /= Just GT ] +++    [ CriticalPair {+        cp_eqn   = r :=: r',+        cp_depth = cp_depth + 1,+        cp_top   = Nothing,+        cp_proof = Proof.symm cp_proof `Proof.trans` erase rs cp_proof }+    | not (null rs), ord /= Just LT ]+    where+      ord = orientTerms l' r'+      l' = erase ls l+      r' = erase rs r+      ls = usort (vars l) \\ usort (vars r)+      rs = usort (vars r) \\ usort (vars l)++      eraseExcept vs t =+        erase (usort (vars t) \\ usort vs) t++-- | Make a critical pair from two rules and an overlap.+{-# INLINEABLE makeCriticalPair #-}+makeCriticalPair ::+  (Has a (Rule f), Has a (Lemma f), Has a Id, Function f) =>+  a -> a -> Overlap f -> Maybe (CriticalPair f)+makeCriticalPair r1 r2 overlap@Overlap{..}+  | lessEq overlap_top t = Nothing+  | lessEq overlap_top u = Nothing+  | otherwise =+    Just $+      CriticalPair overlap_eqn+        overlap_depth+        (Just overlap_top)+        (overlapProof r1 r2 overlap)+  where+    t :=: u = overlap_eqn++-- | Return a proof for a critical pair.+{-# INLINEABLE overlapProof #-}+overlapProof ::+  forall a f.+  (Has a (Rule f), Has a (Lemma f), Has a Id) =>+  a -> a -> Overlap f -> Derivation f+overlapProof left right Overlap{..} =+  Proof.symm (reductionProof (step left leftSub))+  `Proof.trans`+  congPath path overlap_top (reductionProof (step right rightSub))+  where+    Just leftSub = match (lhs (the left)) overlap_top+    Just rightSub = match (lhs (the right)) overlap_inner++    path = positionToPath (lhs (the left) :: Term f) overlap_pos
+ Twee/Constraints.hs view
@@ -0,0 +1,312 @@+{-# LANGUAGE FlexibleContexts, UndecidableInstances, RecordWildCards #-}+-- | Solving constraints on variable ordering.+module Twee.Constraints where++--import Twee.Base hiding (equals, Term, pattern Fun, pattern Var, lookup, funs)+import qualified Twee.Term as Flat+import qualified Data.Map.Strict as Map+import Twee.Pretty hiding (equals)+import Twee.Utils+import Data.Maybe+import Data.List+import Data.Function+import Data.Graph+import Data.Map.Strict(Map)+import Data.Ord+import Twee.Term hiding (lookup)++data Atom f = Constant (Fun f) | Variable Var deriving (Show, Eq, Ord)++{-# INLINE atoms #-}+atoms :: Term f -> [Atom f]+atoms t = aux (singleton t)+  where+    aux Empty = []+    aux (Cons (App f Empty) t) = Constant f:aux t+    aux (Cons (Var x) t) = Variable x:aux t+    aux (ConsSym _ t) = aux t++toTerm :: Atom f -> Term f+toTerm (Constant f) = build (con f)+toTerm (Variable x) = build (var x)++fromTerm :: Flat.Term f -> Maybe (Atom f)+fromTerm (App f Empty) = Just (Constant f)+fromTerm (Var x) = Just (Variable x)+fromTerm _ = Nothing++instance PrettyTerm f => Pretty (Atom f) where+  pPrint = pPrint . toTerm++data Formula f =+    Less   (Atom f) (Atom f)+  | LessEq (Atom f) (Atom f)+  | And [Formula f]+  | Or  [Formula f]+  deriving (Eq, Ord, Show)++instance PrettyTerm f => Pretty (Formula f) where+  pPrintPrec _ _ (Less t u) = hang (pPrint t <+> text "<") 2 (pPrint u)+  pPrintPrec _ _ (LessEq t u) = hang (pPrint t <+> text "<=") 2 (pPrint u)+  pPrintPrec _ _ (And []) = text "true"+  pPrintPrec _ _ (Or []) = text "false"+  pPrintPrec l p (And xs) =+    maybeParens (p > 10)+      (fsep (punctuate (text " &") (nest_ (map (pPrintPrec l 11) xs))))+    where+      nest_ (x:xs) = x:map (nest 2) xs+      nest_ [] = undefined+  pPrintPrec l p (Or xs) =+    maybeParens (p > 10)+      (fsep (punctuate (text " |") (nest_ (map (pPrintPrec l 11) xs))))+    where+      nest_ (x:xs) = x:map (nest 2) xs+      nest_ [] = undefined++negateFormula :: Formula f -> Formula f+negateFormula (Less t u) = LessEq u t+negateFormula (LessEq t u) = Less u t+negateFormula (And ts) = Or (map negateFormula ts)+negateFormula (Or ts) = And (map negateFormula ts)++conj forms+  | false `elem` forms' = false+  | otherwise =+    case forms' of+      [x] -> x+      xs  -> And xs+  where+    flatten (And xs) = xs+    flatten x = [x]+    forms' = filter (/= true) (usort (concatMap flatten forms))+disj forms+  | true `elem` forms' = true+  | otherwise =+    case forms' of+      [x] -> x+      xs  -> Or xs+  where+    flatten (Or xs) = xs+    flatten x = [x]+    forms' = filter (/= false) (usort (concatMap flatten forms))++x &&& y = conj [x, y]+x ||| y = disj [x, y]+true  = And []+false = Or []++data Branch f =+  -- Branches are kept normalised wrt equals+  Branch {+    funs        :: [Fun f],+    less        :: [(Atom f, Atom f)],  -- sorted+    equals      :: [(Atom f, Atom f)] } -- sorted, greatest atom first in each pair+  deriving (Eq, Ord)++instance PrettyTerm f => Pretty (Branch f) where+  pPrint Branch{..} =+    braces $ fsep $ punctuate (text ",") $+      [pPrint x <+> text "<" <+> pPrint y | (x, y) <- less ] +++      [pPrint x <+> text "=" <+> pPrint y | (x, y) <- equals ]++trueBranch :: Branch f+trueBranch = Branch [] [] []++norm :: Eq f => Branch f -> Atom f -> Atom f+norm Branch{..} x = fromMaybe x (lookup x equals)++contradictory :: (Minimal f, Ord f) => Branch f -> Bool+contradictory Branch{..} =+  or [f == minimal | (_, Constant f) <- less] ||+  or [f /= g | (Constant f, Constant g) <- equals] ||+  any cyclic (stronglyConnComp+    [(x, x, [y | (x', y) <- less, x == x']) | x <- usort (map fst less)])+  where+    cyclic (AcyclicSCC _) = False+    cyclic (CyclicSCC _) = True++formAnd :: (Minimal f, Ordered f) => Formula f -> [Branch f] -> [Branch f]+formAnd f bs = usort (bs >>= add f)+  where+    add (Less t u) b = addLess t u b+    add (LessEq t u) b = addLess t u b ++ addEquals t u b+    add (And []) b = [b]+    add (And (f:fs)) b = add f b >>= add (And fs)+    add (Or fs) b = usort (concat [ add f b | f <- fs ])++branches :: (Minimal f, Ordered f) => Formula f -> [Branch f]+branches x = aux [x]+  where+    aux [] = [Branch [] [] []]+    aux (And xs:ys) = aux (xs ++ ys)+    aux (Or xs:ys) = usort $ concat [aux (x:ys) | x <- xs]+    aux (Less t u:xs) = usort $ concatMap (addLess t u) (aux xs)+    aux (LessEq t u:xs) =+      usort $+      concatMap (addLess t u) (aux xs) +++      concatMap (addEquals u t) (aux xs)++addLess :: (Minimal f, Ordered f) => Atom f -> Atom f -> Branch f -> [Branch f]+addLess _ (Constant min) _ | min == minimal = []+addLess (Constant min) _ b | min == minimal = [b]+addLess t0 u0 b@Branch{..} =+  filter (not . contradictory)+    [addTerm t (addTerm u b{less = usort ((t, u):less)})]+  where+    t = norm b t0+    u = norm b u0++addEquals :: (Minimal f, Ordered f) => Atom f -> Atom f -> Branch f -> [Branch f]+addEquals t0 u0 b@Branch{..}+  | t == u || (t, u) `elem` equals = [b]+  | otherwise =+    filter (not . contradictory)+      [addTerm t (addTerm u b {+         equals      = usort $ (t, u):[(x', y') | (x, y) <- equals, let (y', x') = sort2 (sub x, sub y), x' /= y'],+         less        = usort $ [(sub x, sub y) | (x, y) <- less] })]+  where+    sort2 (x, y) = (min x y, max x y)+    (u, t) = sort2 (norm b t0, norm b u0)++    sub x+      | x == t = u+      | otherwise = x++addTerm :: (Minimal f, Ordered f) => Atom f -> Branch f -> Branch f+addTerm (Constant f) b+  | f `notElem` funs b =+    b {+      funs = f:funs b,+      less =+        usort $+          [ (Constant f, Constant g) | g <- funs b, f << g ] +++          [ (Constant g, Constant f) | g <- funs b, g << f ] ++ less b }+addTerm _ b = b++newtype Model f = Model (Map (Atom f) (Int, Int))+  deriving (Eq, Show)+-- Representation: map from atom to (major, minor)+-- x <  y if major x < major y+-- x <= y if major x = major y and minor x < minor y++instance PrettyTerm f => Pretty (Model f) where+  pPrint (Model m)+    | Map.size m <= 1 = text "empty"+    | otherwise = fsep (go (sortBy (comparing snd) (Map.toList m)))+      where+        go [(x, _)] = [pPrint x]+        go ((x, (i, _)):xs@((_, (j, _)):_)) =+          (pPrint x <+> text rel):go xs+          where+            rel = if i == j then "<=" else "<"++modelToLiterals :: Model f -> [Formula f]+modelToLiterals (Model m) = go (sortBy (comparing snd) (Map.toList m))+  where+    go []  = []+    go [_] = []+    go ((x, (i, _)):xs@((y, (j, _)):_)) =+      rel x y:go xs+      where+        rel = if i == j then LessEq else Less++modelFromOrder :: (Minimal f, Ord f) => [Atom f] -> Model f+modelFromOrder xs =+  Model (Map.fromList [(x, (i, i)) | (x, i) <- zip xs [0..]])++weakenModel :: Model f -> [Model f]+weakenModel (Model m) =+  [ Model (Map.delete x m) | x <- Map.keys m ] +++  [ Model (Map.fromList xs)+  | xs <- glue (sortBy (comparing snd) (Map.toList m)),+    all ok (groupBy ((==) `on` (fst . snd)) xs) ]+  where+    glue [] = []+    glue [_] = []+    glue (a@(_x, (i1, j1)):b@(y, (i2, _)):xs) =+      [ (a:(y, (i1, j1+1)):xs) | i1 < i2 ] +++      map (a:) (glue (b:xs))++    -- We must never make two constants equal+    ok xs = length [x | (Constant x, _) <- xs] <= 1++varInModel :: (Minimal f, Ord f) => Model f -> Var -> Bool+varInModel (Model m) x = Variable x `Map.member` m++varGroups :: (Minimal f, Ord f) => Model f -> [(Fun f, [Var], Maybe (Fun f))]+varGroups (Model m) = filter nonempty (go minimal (map fst (sortBy (comparing snd) (Map.toList m))))+  where+    go f xs =+      case span isVariable xs of+        (_, []) -> [(f, map unVariable xs, Nothing)]+        (ys, Constant g:zs) ->+          (f, map unVariable ys, Just g):go g zs+    isVariable (Constant _) = False+    isVariable (Variable _) = True+    unVariable (Variable x) = x+    nonempty (_, [], _) = False+    nonempty _ = True++class Minimal f where+  minimal :: Fun f++{-# INLINE lessEqInModel #-}+lessEqInModel :: (Minimal f, Ordered f) => Model f -> Atom f -> Atom f -> Maybe Strictness+lessEqInModel (Model m) x y+  | Just (a, _) <- Map.lookup x m,+    Just (b, _) <- Map.lookup y m,+    a < b = Just Strict+  | Just a <- Map.lookup x m,+    Just b <- Map.lookup y m,+    a < b = Just Nonstrict+  | x == y = Just Nonstrict+  | Constant a <- x, Constant b <- y, a << b = Just Strict+  | Constant a <- x, a == minimal = Just Nonstrict+  | otherwise = Nothing++solve :: (Minimal f, Ordered f, PrettyTerm f) => [Atom f] -> Branch f -> Either (Model f) (Subst f)+solve xs branch@Branch{..}+  | null equals && not (all true less) =+    error $ "Model " ++ prettyShow model ++ " is not a model of " ++ prettyShow branch ++ " (edges = " ++ prettyShow edges ++ ", vs = " ++ prettyShow vs ++ ")"+  | null equals = Left model+  | otherwise = Right sub+    where+      sub = fromMaybe undefined . listToSubst $+        [(x, toTerm y) | (Variable x, y) <- equals] +++        [(y, toTerm x) | (x@Constant{}, Variable y) <- equals]+      vs = Constant minimal:reverse (flattenSCCs (stronglyConnComp edges))+      edges = [(x, x, [y | (x', y) <- less', x == x']) | x <- as, x /= Constant minimal]+      less' = less ++ [(Constant x, Constant y) | Constant x <- as, Constant y <- as, x << y]+      as = usort $ xs ++ map fst less ++ map snd less+      model = modelFromOrder vs+      true (t, u) = lessEqInModel model t u == Just Strict++class Ord f => Ordered f where+  -- | Return 'True' if the first term is less than or equal to the second,+  -- in the term ordering.+  lessEq :: Term f -> Term f -> Bool+  -- | Check if the first term is less than or equal to the second in the given model,+  -- and decide whether the inequality is strict or nonstrict.+  lessIn :: Model f -> Term f -> Term f -> Maybe Strictness++-- | Describes whether an inequality is strict or nonstrict.+data Strictness =+    -- | The first term is strictly less than the second.+    Strict+    -- | The first term is less than or equal to the second.+  | Nonstrict deriving (Eq, Show)++-- | Return 'True' if the first argument is strictly less than the second,+-- in the term ordering.+lessThan :: Ordered f => Term f -> Term f -> Bool+lessThan t u = lessEq t u && isNothing (unify t u)++-- | Return the direction in which the terms are oriented according to the term+-- ordering, or 'Nothing' if they cannot be oriented. A result of @'Just' 'LT'@+-- means that the first term is less than /or equal to/ the second.+orientTerms :: Ordered f => Term f -> Term f -> Maybe Ordering+orientTerms t u+  | t == u = Just EQ+  | lessEq t u = Just LT+  | lessEq u t = Just GT+  | otherwise = Nothing
+ Twee/Equation.hs view
@@ -0,0 +1,58 @@+-- | Equations.+{-# LANGUAGE TypeFamilies #-}+module Twee.Equation where++import Twee.Base+import Data.Maybe+import Control.Monad++--------------------------------------------------------------------------------+-- * Equations.+--------------------------------------------------------------------------------++data Equation f =+  (:=:) {+    eqn_lhs :: {-# UNPACK #-} !(Term f),+    eqn_rhs :: {-# UNPACK #-} !(Term f) }+  deriving (Eq, Ord, Show)+type EquationOf a = Equation (ConstantOf a)++instance Symbolic (Equation f) where+  type ConstantOf (Equation f) = f+  termsDL (t :=: u) = termsDL t `mplus` termsDL u+  subst_ sub (t :=: u) = subst_ sub t :=: subst_ sub u++instance PrettyTerm f => Pretty (Equation f) where+  pPrint (x :=: y) = pPrint x <+> text "=" <+> pPrint y++instance Sized f => Sized (Equation f) where+  size (x :=: y) = size x + size y++-- | Order an equation roughly left-to-right.+-- However, there is no guarantee that the result is oriented.+order :: Function f => Equation f -> Equation f+order (l :=: r)+  | l == r = l :=: r+  | otherwise =+    case compare (size l) (size r) of+      LT -> r :=: l+      GT -> l :=: r+      EQ -> if lessEq l r then r :=: l else l :=: r++-- | Apply a function to both sides of an equation.+bothSides :: (Term f -> Term f') -> Equation f -> Equation f'+bothSides f (t :=: u) = f t :=: f u++-- | Is an equation of the form t = t?+trivial :: Eq f => Equation f -> Bool+trivial (t :=: u) = t == u++simplerThan :: Function f => Equation f -> Equation f -> Bool+eq1 `simplerThan` eq2 =+  t1 `lessEq` t2 &&+  (isNothing (unify t1 t2) || (u1 `lessEq` u2))+  where+    t1 :=: u1 = skolemise eq1+    t2 :=: u2 = skolemise eq2++    skolemise = subst (con . skolem)
+ Twee/Index.hs view
@@ -0,0 +1,310 @@+-- | A term index to accelerate matching.+-- An index is a multimap from terms to arbitrary values.+--+-- The type of query supported is: given a search term, find all keys such that+-- the search term is an instance of the key, and return the corresponding+-- values.++{-# LANGUAGE BangPatterns, RecordWildCards, OverloadedStrings, FlexibleContexts #-}+-- We get some bogus warnings because of pattern synonyms.+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}+module Twee.Index(+  Index,+  empty,+  null,+  singleton,+  insert,+  delete,+  lookup,+  matches,+  approxMatches,+  elems) where++import qualified Prelude+import Prelude hiding (null, lookup)+import Data.Maybe+import Twee.Base hiding (var, fun, empty, size, singleton, prefix, funs, lookupList, lookup)+import qualified Twee.Term as Term+import Twee.Term.Core(TermList(..))+import Data.DynamicArray+import qualified Data.List as List++-- The term index in this module is an _imperfect discrimination tree_.+-- This is a trie whose keys are terms, represented as flat lists of symbols,+-- but where all variables have been replaced by a single don't-care variable '_'.+-- That is, the edges of the trie can be either function symbols or '_'.+-- To insert a key-value pair into the discrimination tree, we first replace all+-- variables in the key with '_', and then do ordinary trie insertion.+--+-- Lookup maintains a term list, which is initially the search term.+-- It proceeds down the trie, consuming bits of the term list as it goes.+--+-- If the current trie node has an edge for a function symbol f, and the term at+-- the head of the term list is f(t1..tn), we can follow the f edge. We then+-- delete f from the term list, but keep t1..tn at the front of the term list.+-- (In other words we delete only the symbol f and not its arguments.)+--+-- If the current trie node has an edge for '_', we can always follow that edge.+-- We then remove the head term from the term list, as the '_' represents a+-- variable that should match that whole term.+--+-- If the term list ever becomes empty, we have a possible match. We then+-- do matching on the values stored at the current node to see if they are+-- genuine matches.+--+-- Often there are two edges we can follow (function symbol and '_'), and in+-- that case the algorithm uses backtracking.++-- | A term index: a multimap from @'Term' f@ to @a@.+data Index f a =+  -- A non-empty index.+  Index {+    -- Size of smallest term in index.+    size   :: {-# UNPACK #-} !Int,+    -- When all keys in the index start with the same sequence of symbols, we+    -- compress them into this prefix; the "fun" and "var" fields below refer to+    -- the first symbol _after_ the prefix, and the "here" field contains values+    -- whose remaining key is exactly this prefix.+    prefix :: {-# UNPACK #-} !(TermList f),+    -- The values that are found at this node.+    here   :: [a],+    -- Function symbol edges.+    -- The array is indexed by function number.+    fun    :: {-# UNPACK #-} !(Array (Index f a)),+    -- Variable edge.+    var    :: !(Index f a) } |+  -- An empty index.+  Nil+  deriving Show++instance Default (Index f a) where def = Nil++-- To get predictable performance, the lookup function uses an explicit stack+-- instead of recursion to control backtracking.+data Stack f a =+  -- A normal stack frame: records the current index node and term.+  Frame {+    frame_term  :: {-# UNPACK #-} !(TermList f),+    frame_index :: !(Index f a),+    frame_rest  :: !(Stack f a) }+  -- A stack frame which is used when we have found a match.+  | Yield {+    yield_found :: [a],+    yield_rest  :: !(Stack f a) }+  -- End of stack.+  | Stop++-- Turn a stack into a list of results.+run :: Stack f a -> [a]+run Stop = []+run Frame{..} = run ({-# SCC run_inner #-} step frame_term frame_index frame_rest)+run Yield{..} = {-# SCC run_found #-} yield_found ++ run yield_rest++-- Execute a single stack frame.+{-# INLINE step #-}+step :: TermList f -> Index f a -> Stack f a -> Stack f a+step !_ _ _ | False = undefined+step t idx rest =+  case idx of+    Nil -> rest+    Index{..}+      | lenList t < size ->+        rest -- the search term is smaller than any in this index+      | otherwise ->+        pref t prefix here fun var rest++-- The main work of 'step' goes on here.+-- It is carefully tweaked to generate nice code,+-- including using UnsafeCons and only casing on each+-- term list exactly once.+pref :: TermList f -> TermList f -> [a] -> Array (Index f a) -> Index f a -> Stack f a -> Stack f a+pref !_ !_ _ !_ !_ _ | False = undefined+pref search prefix here fun var rest =+  case search of+    Empty ->+      case prefix of+        Empty ->+          -- The search term matches this node.+          case here of+            [] -> rest+            _ -> Yield here rest+        _ ->+          -- We've run out of search term - it doesn't match this node.+          rest+    UnsafeCons t ts ->+      case prefix of+        Cons u us ->+          -- Check the search term against the prefix.+          case (t, u) of+            (_, Var _) ->+              -- Prefix contains a variable - if there is a match, the+              -- variable will be bound to t.+              pref ts us here fun var rest+            (App f _, App g _) | f == g ->+              -- Term and prefix start with same symbol, chop them off.+               let+                 UnsafeConsSym _ ts' = search+                 UnsafeConsSym _ us' = prefix+               in pref ts' us' here fun var rest+            _ ->+              -- Term and prefix don't match.+              rest+        _ ->+          -- We've exhausted the prefix, so let's descend into the tree.+          -- Seems to work better to explore the function node first.+          let+            tryVar =+              case var of+                Nil -> rest+                Index{} -> Frame ts var rest+              where+                UnsafeCons _ ts = search++            tryFun =+              case t of+                App f _ ->+                  case fun ! fun_id f of+                    Nil -> tryVar+                    idx -> Frame ts idx $! tryVar+                _ ->+                  tryVar+              where+                UnsafeConsSym t ts = search+          in+            tryFun++-- | An empty index.+empty :: Index f a+empty = Nil++-- | Is the index empty?+null :: Index f a -> Bool+null Nil = True+null _ = False++-- | An index with one entry.+singleton :: Term f -> a -> Index f a+singleton !t x = singletonList (Term.singleton t) x++-- An index with one entry, giving a termlist instead of a term.+{-# INLINE singletonList #-}+singletonList :: TermList f -> a -> Index f a+singletonList t x = Index 0 t [x] newArray Nil++-- | Insert an entry into the index.+insert :: Term f -> a -> Index f a -> Index f a+insert !t x !idx = {-# SCC insert #-} aux (Term.singleton t) idx+  where+    aux t Nil = singletonList t x+    aux (Cons t ts) idx@Index{prefix = Cons u us} | t == u =+      withPrefix (Term.singleton t) (aux ts idx{prefix = us})+    aux t idx@Index{prefix = Cons{}} = aux t (expand idx)++    aux Empty idx =+      idx { size = 0, here = x:here idx }+    aux t@(ConsSym (App f _) u) idx =+      idx {+        size = lenList t `min` size idx,+        fun  = update (fun_id f) idx' (fun idx) }+      where+        idx' = aux u (fun idx ! fun_id f)+    aux t@(ConsSym (Var _) u) idx =+      idx {+        size = lenList t `min` size idx,+        var  = aux u (var idx) }++-- Add a prefix to an index.+-- Does not update the size field.+{-# INLINE withPrefix #-}+withPrefix :: TermList f -> Index f a -> Index f a+withPrefix Empty idx = idx+withPrefix _ Nil = Nil+withPrefix t idx@Index{..} =+  idx{prefix = buildList (builder t `mappend` builder prefix)}++-- Take an index with a prefix and pull out the first symbol of the prefix,+-- giving an index which doesn't start with a prefix.+{-# INLINE expand #-}+expand :: Index f a -> Index f a+expand idx@Index{size = size, prefix = ConsSym t ts} =+  case t of+    Var _ ->+      Index {+        size = size,+        prefix = Term.empty,+        here = [],+        fun = newArray,+        var = idx { prefix = ts, size = size - 1 } }+    App f _ ->+      Index {+        size = size,+        prefix = Term.empty,+        here = [],+        fun = update (fun_id f) idx { prefix = ts, size = size - 1 } newArray,+        var = Nil }++-- | Delete an entry from the index.+{-# INLINEABLE delete #-}+delete :: Eq a => Term f -> a -> Index f a -> Index f a+delete !t x !idx = {-# SCC delete #-} aux (Term.singleton t) idx+  where+    aux _ Nil = Nil+    aux (Cons t ts) idx@Index{prefix = Cons u us} | t == u =+      withPrefix (Term.singleton t) (aux ts idx{prefix = us})+    aux _ idx@Index{prefix = Cons{}} = idx++    aux Empty idx+      | x `List.elem` here idx =+        idx { here = List.delete x (here idx) }+      | otherwise =+        error "deleted term not found in index"+    aux (ConsSym (App f _) t) idx =+      idx { fun = update (fun_id f) (aux t (fun idx ! fun_id f)) (fun idx) }+    aux (ConsSym (Var _) t) idx =+      idx { var = aux t (var idx) }++-- | Look up a term in the index. Finds all key-value such that the search term+-- is an instance of the key, and returns an instance of the the value which+-- makes the search term exactly equal to the key.+{-# INLINE lookup #-}+lookup :: (Has a b, Symbolic b, Has b (TermOf b)) => TermOf b -> Index (ConstantOf b) a -> [b]+lookup t idx = lookupList (Term.singleton t) idx++{-# INLINEABLE lookupList #-}+lookupList :: (Has a b, Symbolic b, Has b (TermOf b)) => TermListOf b -> Index (ConstantOf b) a -> [b]+lookupList t idx =+  [ subst sub x+  | x <- List.map the (approxMatchesList t idx),+    sub <- maybeToList (matchList (Term.singleton (the x)) t)]++-- | Look up a term in the index. Like 'lookup', but returns the exact value+-- that was inserted into the index, not an instance. Also returns a substitution+-- which when applied to the value gives you the matching instance.+{-# INLINE matches #-}+matches :: Has a (Term f) => Term f -> Index f a -> [(Subst f, a)]+matches t idx = matchesList (Term.singleton t) idx++{-# INLINEABLE matchesList #-}+matchesList :: Has a (Term f) => TermList f -> Index f a -> [(Subst f, a)]+matchesList t idx =+  [ (sub, x)+  | x <- approxMatchesList t idx,+    sub <- maybeToList (matchList (Term.singleton (the x)) t)]++-- | Look up a term in the index, possibly returning spurious extra results.+{-# INLINE approxMatches #-}+approxMatches :: Term f -> Index f a -> [a]+approxMatches t idx = approxMatchesList (Term.singleton t) idx++approxMatchesList :: TermList f -> Index f a -> [a]+approxMatchesList t idx =+  {-# SCC approxMatchesList #-}+  run (Frame t idx Stop)++-- | Return all elements of the index.+elems :: Index f a -> [a]+elems Nil = []+elems idx =+  here idx +++  concatMap elems (Prelude.map snd (toList (fun idx))) +++  elems (var idx)
+ Twee/Join.hs view
@@ -0,0 +1,212 @@+-- | Tactics for joining critical pairs.+{-# LANGUAGE FlexibleContexts, BangPatterns, RecordWildCards, TypeFamilies #-}+module Twee.Join where++import Twee.Base+import Twee.Rule+import Twee.Equation+import Twee.Proof(Lemma)+import qualified Twee.Proof as Proof+import Twee.CP hiding (Config)+import Twee.Constraints+import qualified Twee.Index as Index+import Twee.Index(Index)+import Twee.Rule.Index(RuleIndex(..))+import Twee.Utils+import Data.Maybe+import Data.Either+import Data.Ord+import qualified Data.Set as Set++data Config =+  Config {+    cfg_ground_join :: !Bool,+    cfg_use_connectedness :: !Bool,+    cfg_set_join :: !Bool }++defaultConfig :: Config+defaultConfig =+  Config {+    cfg_ground_join = True,+    cfg_use_connectedness = True,+    cfg_set_join = False }++{-# INLINEABLE joinCriticalPair #-}+joinCriticalPair ::+  (Function f, Has a (Rule f), Has a (Lemma f)) =>+  Config ->+  Index f (Equation f) -> RuleIndex f a ->+  Maybe (Model f) -> -- A model to try before checking ground joinability+  CriticalPair f ->+  Either+    -- Failed to join critical pair.+    -- Returns simplified critical pair and model in which it failed to hold.+    (CriticalPair f, Model f)+    -- Split critical pair into several instances.+    -- Returns list of instances which must be joined,+    -- and an optional equation which can be added to the joinable set+    -- after successfully joining all instances.+    (Maybe (CriticalPair f), [CriticalPair f])+joinCriticalPair config eqns idx mmodel cp@CriticalPair{cp_eqn = t :=: u} =+  {-# SCC joinCriticalPair #-}+  case allSteps config eqns idx cp of+    Nothing ->+      Right (Nothing, [])+    _ | cfg_set_join config &&+        not (null $ Set.intersection+          (normalForms (rewrite reduces (index_all idx)) [reduce (Refl t)])+          (normalForms (rewrite reduces (index_all idx)) [reduce (Refl u)])) ->+      Right (Just cp, [])+    Just cp ->+      case groundJoinFromMaybe config eqns idx mmodel (branches (And [])) cp of+        Left model -> Left (cp, model)+        Right cps -> Right (Just cp, cps)++{-# INLINEABLE step1 #-}+{-# INLINEABLE step2 #-}+{-# INLINEABLE step3 #-}+{-# INLINEABLE allSteps #-}+step1, step2, step3, allSteps ::+  (Function f, Has a (Rule f), Has a (Lemma f)) =>+  Config -> Index f (Equation f) -> RuleIndex f a -> CriticalPair f -> Maybe (CriticalPair f)+allSteps config eqns idx cp =+  step1 config eqns idx cp >>=+  step2 config eqns idx >>=+  step3 config eqns idx+step1 _ eqns idx = joinWith eqns idx (\t _ -> normaliseWith (const True) (rewrite reducesOriented (index_oriented idx)) t)+step2 _ eqns idx = joinWith eqns idx (\t _ -> normaliseWith (const True) (rewrite reduces (index_all idx)) t)+step3 Config{..} eqns idx cp+  | not cfg_use_connectedness = Just cp+  | otherwise =+    case cp_top cp of+      Just top ->+        case (join (cp, top), join (flipCP (cp, top))) of+          (Just _, Just _) -> Just cp+          _ -> Nothing+      _ -> Just cp+  where+    join (cp, top) =+      joinWith eqns idx (\t u -> normaliseWith (`lessThan` top) (rewrite (ok t u) (index_all idx)) t) cp++    ok t u rule sub =+      unorient rule `simplerThan` (t :=: u) &&+      reducesSkolem rule sub++    flipCP :: Symbolic a => a -> a+    flipCP t = subst sub t+      where+        n = maximum (0:map fromEnum (vars t))+        sub (V x) = var (V (n - x))+++{-# INLINEABLE joinWith #-}+joinWith ::+  (Has a (Rule f), Has a (Lemma f)) =>+  Index f (Equation f) -> RuleIndex f a -> (Term f -> Term f -> Resulting f) -> CriticalPair f -> Maybe (CriticalPair f)+joinWith eqns idx reduce cp@CriticalPair{cp_eqn = lhs :=: rhs, ..}+  | subsumed eqns idx eqn = Nothing+  | otherwise =+    Just cp {+      cp_eqn = eqn,+      cp_proof =+        Proof.symm (reductionProof (reduction lred)) `Proof.trans`+        cp_proof `Proof.trans`+        reductionProof (reduction rred) }+  where+    lred = reduce lhs rhs+    rred = reduce rhs lhs+    eqn = result lred :=: result rred++{-# INLINEABLE subsumed #-}+subsumed ::+  (Has a (Rule f), Has a (Lemma f)) =>+  Index f (Equation f) -> RuleIndex f a -> Equation f -> Bool+subsumed eqns idx (t :=: u)+  | t == u = True+  | or [ rhs rule == u | rule <- Index.lookup t (index_all idx) ] = True+  | or [ rhs rule == t | rule <- Index.lookup u (index_all idx) ] = True+    -- No need to do this symmetrically because addJoinable adds+    -- both orientations of each equation+  | or [ u == subst sub u'+       | t' :=: u' <- Index.approxMatches t eqns,+         sub <- maybeToList (match t' t) ] = True+subsumed eqns idx (App f ts :=: App g us)+  | f == g =+    let+      sub Empty Empty = True+      sub (Cons t ts) (Cons u us) =+        subsumed eqns idx (t :=: u) && sub ts us+      sub _ _ = error "Function used with multiple arities"+    in+      sub ts us+subsumed _ _ _ = False++{-# INLINEABLE groundJoin #-}+groundJoin ::+  (Function f, Has a (Rule f), Has a (Lemma f)) =>+  Config -> Index f (Equation f) -> RuleIndex f a -> [Branch f] -> CriticalPair f -> Either (Model f) [CriticalPair f]+groundJoin config eqns idx ctx cp@CriticalPair{cp_eqn = t :=: u, ..} =+  case partitionEithers (map (solve (usort (atoms t ++ atoms u))) ctx) of+    ([], instances) ->+      let cps = [ subst sub cp | sub <- instances ] in+      Right (usortBy (comparing (canonicalise . order . cp_eqn)) cps)+    (model:_, _) ->+      groundJoinFrom config eqns idx model ctx cp++{-# INLINEABLE groundJoinFrom #-}+groundJoinFrom ::+  (Function f, Has a (Rule f), Has a (Lemma f)) =>+  Config -> Index f (Equation f) -> RuleIndex f a -> Model f -> [Branch f] -> CriticalPair f -> Either (Model f) [CriticalPair f]+groundJoinFrom config@Config{..} eqns idx model ctx cp@CriticalPair{cp_eqn = t :=: u, ..}+  | not cfg_ground_join ||+    (modelOK model && isJust (allSteps config eqns idx cp { cp_eqn = t' :=: u' })) = Left model+  | otherwise =+      let model1 = optimise model weakenModel (\m -> not (modelOK m) || (valid m (reduction nt) && valid m (reduction nu)))+          model2 = optimise model1 weakenModel (\m -> not (modelOK m) || isNothing (allSteps config eqns idx cp { cp_eqn = result (normaliseIn m t u) :=: result (normaliseIn m u t) }))++          diag [] = Or []+          diag (r:rs) = negateFormula r ||| (weaken r &&& diag rs)+          weaken (LessEq t u) = Less t u+          weaken x = x+          ctx' = formAnd (diag (modelToLiterals model2)) ctx in++      groundJoin config eqns idx ctx' cp+  where+    normaliseIn m t u = normaliseWith (const True) (rewrite (ok t u m) (index_all idx)) t+    ok t u m rule sub =+      reducesInModel m rule sub &&+      unorient rule `simplerThan` (t :=: u)++    nt = normaliseIn model t u+    nu = normaliseIn model u t+    t' = result nt+    u' = result nu++    -- XXX not safe to exploit the top term if we then add the equation to+    -- the joinable set. (It might then be used to join a CP with an entirely+    -- different top term.)+    modelOK _ = True+{-    modelOK m =+      case cp_top of+        Nothing -> True+        Just top ->+          isNothing (lessIn m top t) && isNothing (lessIn m top u)-}++{-# INLINEABLE groundJoinFromMaybe #-}+groundJoinFromMaybe ::+  (Function f, Has a (Rule f), Has a (Lemma f)) =>+  Config -> Index f (Equation f) -> RuleIndex f a -> Maybe (Model f) -> [Branch f] -> CriticalPair f -> Either (Model f) [CriticalPair f]+groundJoinFromMaybe config eqns idx Nothing = groundJoin config eqns idx+groundJoinFromMaybe config eqns idx (Just model) = groundJoinFrom config eqns idx model++{-# INLINEABLE valid #-}+valid :: Function f => Model f -> Reduction f -> Bool+valid model red =+  and [ reducesInModel model rule sub+      | Step _ rule sub <- steps red ]++optimise :: a -> (a -> [a]) -> (a -> Bool) -> a+optimise x f p =+  case filter p (f x) of+    y:_ -> optimise y f p+    _   -> x
+ Twee/KBO.hs view
@@ -0,0 +1,121 @@+-- | An implementation of Knuth-Bendix ordering.++{-# LANGUAGE PatternGuards #-}+module Twee.KBO(lessEq, lessIn) where++import Twee.Base hiding (lessEq, lessIn)+import Data.List+import Twee.Constraints hiding (lessEq, lessIn)+import qualified Data.Map.Strict as Map+import Data.Map.Strict(Map)+import Data.Maybe+import Control.Monad++-- | Check if one term is less than another in KBO.+lessEq :: Function f => Term f -> Term f -> Bool+lessEq (App f Empty) _ | f == minimal = True+lessEq (Var x) (Var y) | x == y = True+lessEq _ (Var _) = False+lessEq (Var x) t = x `elem` vars t+lessEq t@(App f ts) u@(App g us) =+  (st < su ||+   (st == su && f << g) ||+   (st == su && f == g && lexLess ts us)) &&+  xs `isSubsequenceOf` ys+  where+    lexLess Empty Empty = True+    lexLess (Cons t ts) (Cons u us)+      | t == u = lexLess ts us+      | otherwise =+        lessEq t u &&+        case unify t u of+          Nothing -> True+          Just sub+            | not (allSubst (\_ (Cons t Empty) -> isMinimal t) sub) -> error "weird term inequality"+            | otherwise -> lexLess (subst sub ts) (subst sub us)+    lexLess _ _ = error "incorrect function arity"+    xs = sort (vars t)+    ys = sort (vars u)+    st = size t+    su = size u++-- | Check if one term is less than another in a given model.++-- See "notes/kbo under assumptions" for how this works.++lessIn :: Function f => Model f -> Term f -> Term f -> Maybe Strictness+lessIn model t u =+  case sizeLessIn model t u of+    Nothing -> Nothing+    Just Strict -> Just Strict+    Just Nonstrict -> lexLessIn model t u++sizeLessIn :: Function f => Model f -> Term f -> Term f -> Maybe Strictness+sizeLessIn model t u =+  case minimumIn model m of+    Just l+      | l >  -k -> Just Strict+      | l == -k -> Just Nonstrict+    _ -> Nothing+  where+    (k, m) =+      foldr (addSize id)+        (foldr (addSize negate) (0, Map.empty) (subterms t))+        (subterms u)+    addSize op (App f _) (k, m) = (k + op (size f), m)+    addSize op (Var x) (k, m) = (k, Map.insertWith (+) x (op 1) m)++minimumIn :: Function f => Model f -> Map Var Int -> Maybe Int+minimumIn model t =+  liftM2 (+)+    (fmap sum (mapM minGroup (varGroups model)))+    (fmap sum (mapM minOrphan (Map.toList t)))+  where+    minGroup (lo, xs, mhi)+      | all (>= 0) sums = Just (sum coeffs * size lo)+      | otherwise =+        case mhi of+          Nothing -> Nothing+          Just hi ->+            let coeff = negate (minimum coeffs) in+            Just $+              sum coeffs * size lo ++              coeff * (size lo - size hi)+      where+        coeffs = map (\x -> Map.findWithDefault 0 x t) xs+        sums = scanr1 (+) coeffs++    minOrphan (x, k)+      | varInModel model x = Just 0+      | k < 0 = Nothing+      | otherwise = Just k++lexLessIn :: Function f => Model f -> Term f -> Term f -> Maybe Strictness+lexLessIn _ t u | t == u = Just Nonstrict+lexLessIn cond t u+  | Just a <- fromTerm t,+    Just b <- fromTerm u,+    Just x <- lessEqInModel cond a b = Just x+  | Just a <- fromTerm t,+    any isJust+      [ lessEqInModel cond a b+      | v <- properSubterms u, Just b <- [fromTerm v]] =+        Just Strict+lexLessIn cond (App f ts) (App g us)+  | f == g = loop ts us+  | f << g = Just Strict+  | otherwise = Nothing+  where+    loop Empty Empty = Just Nonstrict+    loop (Cons t ts) (Cons u us)+      | t == u = loop ts us+      | otherwise =+        case lessIn cond t u of+          Nothing -> Nothing+          Just Strict -> Just Strict+          Just Nonstrict ->+            let Just sub = unify t u in+            loop (subst sub ts) (subst sub us)+    loop _ _ = error "incorrect function arity"+lexLessIn _ t _ | isMinimal t = Just Nonstrict+lexLessIn _ _ _ = Nothing
+ Twee/Label.hs view
@@ -0,0 +1,125 @@+-- | Assignment of unique IDs to values.+-- Inspired by the 'intern' package.++{-# LANGUAGE RecordWildCards, ScopedTypeVariables, BangPatterns #-}+module Twee.Label(Label, unsafeMkLabel, labelNum, label, find) where++import Data.IORef+import System.IO.Unsafe+import qualified Data.Map.Strict as Map+import Data.Map.Strict(Map)+import qualified Data.IntMap.Strict as IntMap+import Data.IntMap.Strict(IntMap)+import Data.Typeable+import GHC.Exts+import Unsafe.Coerce+import Data.Int++-- | A value of type @a@ which has been given a unique ID.+newtype Label a =+  Label {+    -- | The unique ID of a label.+    labelNum :: Int32 }+  deriving (Eq, Ord, Show)++-- | Construct a @'Label' a@ from its unique ID, which must be the 'labelNum' of+-- an already existing 'Label'. Extremely unsafe!+unsafeMkLabel :: Int32 -> Label a+unsafeMkLabel = Label++-- The global cache of labels.+{-# NOINLINE cachesRef #-}+cachesRef :: IORef Caches+cachesRef = unsafePerformIO (newIORef (Caches 0 Map.empty IntMap.empty))++data Caches =+  Caches {+    -- The next id number to assign.+    caches_nextId :: {-# UNPACK #-} !Int32,+    -- A map from values to labels.+    caches_from   :: !(Map TypeRep (Cache Any)),+    -- The reverse map from labels to values.+    caches_to     :: !(IntMap Any) }++type Cache a = Map a Int32++atomicModifyCaches :: (Caches -> (Caches, a)) -> IO a+atomicModifyCaches f = do+  -- N.B. atomicModifyIORef' ref f evaluates f ref *after* doing the+  -- compare-and-swap. This causes bad things to happen when 'label'+  -- is used reentrantly (i.e. the Ord instance itself calls label).+  -- This function only lets the swap happen if caches_nextId didn't+  -- change (i.e., no new values were inserted).+  !caches <- readIORef cachesRef+  -- First compute the update.+  let !(!caches', !x) = f caches+  -- Now see if anyone else updated the cache in between+  -- (can happen if f called 'label', or in a concurrent setting).+  ok <- atomicModifyIORef' cachesRef $ \cachesNow ->+    if caches_nextId caches == caches_nextId cachesNow+    then (caches', True)+    else (cachesNow, False)+  if ok then return x else atomicModifyCaches f++-- Versions of unsafeCoerce with slightly more type checking+toAnyCache :: Cache a -> Cache Any+toAnyCache = unsafeCoerce++fromAnyCache :: Cache Any -> Cache a+fromAnyCache = unsafeCoerce++toAny :: a -> Any+toAny = unsafeCoerce++fromAny :: Any -> a+fromAny = unsafeCoerce++-- | Assign a label to a value.+{-# NOINLINE label #-}+label :: forall a. (Typeable a, Ord a) => a -> Label a+label x =+  unsafeDupablePerformIO $ do+    -- Common case: label is already there.+    caches <- readIORef cachesRef+    case tryFind caches of+      Just l -> return l+      Nothing -> do+        -- Rare case: label was not there.+        x <- atomicModifyCaches $ \caches ->+          case tryFind caches of+            Just l -> (caches, l)+            Nothing ->+              insert caches+        return x++  where+    ty = typeOf x++    tryFind :: Caches -> Maybe (Label a)+    tryFind Caches{..} =+      Label <$> (Map.lookup ty caches_from >>= Map.lookup x . fromAnyCache)++    insert :: Caches -> (Caches, Label a)+    insert caches@Caches{..} =+      if n < 0 then error "label overflow" else+      (caches {+         caches_nextId = n+1,+         caches_from = Map.insert ty (toAnyCache (Map.insert x n cache)) caches_from,+         caches_to = IntMap.insert (fromIntegral n) (toAny x) caches_to },+       Label n)+      where+        n = caches_nextId+        cache =+          fromAnyCache $+          Map.findWithDefault Map.empty ty caches_from++-- | Recover the underlying value from a label.+find :: Label a -> a+-- N.B. must force n before calling readIORef, otherwise a call of+-- the form+--   find (label x)+-- doesn't work.+find (Label !n) = unsafeDupablePerformIO $ do+  Caches{..} <- readIORef cachesRef+  x <- return $! fromAny (IntMap.findWithDefault undefined (fromIntegral n) caches_to)+  return x
+ Twee/PassiveQueue.hs view
@@ -0,0 +1,183 @@+-- | A queue of passive critical pairs, using a memory-efficient representation.+{-# LANGUAGE TypeFamilies, RecordWildCards, FlexibleContexts, ScopedTypeVariables, StandaloneDeriving #-}+module Twee.PassiveQueue(+  Params(..),+  Queue,+  Passive(..),+  empty, insert, removeMin, mapMaybe) where++import qualified Data.Heap as Heap+import qualified Data.Vector.Unboxed as Vector+import Data.Int+import Data.List hiding (insert)+import qualified Data.Maybe+import Data.Ord+import Data.Proxy+import Twee.Utils++-- | A datatype representing all the type parameters of the queue.+class (Eq (Id params), Integral (Id params), Ord (Score params), Vector.Unbox (PackedScore params), Vector.Unbox (PackedId params)) => Params params where+  -- | The score assigned to critical pairs. Smaller scores are better.+  type Score params+  -- | The type of ID numbers used to name rules.+  type Id params++  -- | A 'Score' packed for storage into a 'Vector.Vector'. Must be an instance of 'Vector.Unbox'.+  type PackedScore params+  -- | An 'Id' packed for storage into a 'Vector.Vector'. Must be an instance of 'Vector.Unbox'.+  type PackedId params++  -- | Pack a 'Score'.+  packScore :: proxy params -> Score params -> PackedScore params+  -- | Unpack a 'PackedScore'.+  unpackScore :: proxy params -> PackedScore params -> Score params+  -- | Pack an 'Id'.+  packId :: proxy params -> Id params -> PackedId params+  -- | Unpack a 'PackedId'.+  unpackId :: proxy params -> PackedId params -> Id params++-- | A critical pair queue.+newtype Queue params =+  Queue (Heap.Heap (PassiveSet params))++-- All passive CPs generated from one given rule.+data PassiveSet params =+  PassiveSet {+    passiveset_best  :: {-# UNPACK #-} !(Passive params),+    passiveset_rule  :: !(Id params),+    -- CPs where the rule is the left-hand rule+    passiveset_left  :: {-# UNPACK #-} !(Vector.Vector (PackedScore params, PackedId params, Int32)),+    -- CPs where the rule is the right-hand rule+    passiveset_right :: {-# UNPACK #-} !(Vector.Vector (PackedScore params, PackedId params, Int32)) }+instance Params params => Eq (PassiveSet params) where+  x == y = compare x y == EQ+instance Params params => Ord (PassiveSet params) where+  compare = comparing passiveset_best++-- A smart-ish constructor.+{-# INLINEABLE mkPassiveSet #-}+mkPassiveSet ::+  Params params =>+  Proxy params ->+  Id params ->+  Vector.Vector (PackedScore params, PackedId params, Int32) ->+  Vector.Vector (PackedScore params, PackedId params, Int32) ->+  Maybe (PassiveSet params)+mkPassiveSet proxy rule left right+  | Vector.null left && Vector.null right = Nothing+  | not (Vector.null left) &&+    (Vector.null right || l <= r) =+    Just PassiveSet {+      passiveset_best  = l,+      passiveset_rule  = rule,+      passiveset_left  = Vector.tail left,+      passiveset_right = right }+    -- In this case we must have not (Vector.null right).+  | otherwise =+    Just PassiveSet {+      passiveset_best  = r,+      passiveset_rule  = rule,+      passiveset_left  = left,+      passiveset_right = Vector.tail right }+  where+    l = unpack proxy rule True (Vector.head left)+    r = unpack proxy rule False (Vector.head right)++-- Unpack a triple into a Passive.+{-# INLINEABLE unpack #-}+unpack :: Params params => Proxy params -> Id params -> Bool -> (PackedScore params, PackedId params, Int32) -> Passive params+unpack proxy rule isLeft (score, id, pos) =+  Passive {+    passive_score = unpackScore proxy score,+    passive_rule1 = if isLeft then rule else rule',+    passive_rule2 = if isLeft then rule' else rule,+    passive_pos = fromIntegral pos }+  where+    rule' = unpackId proxy id++-- Make a PassiveSet from a list of Passives.+{-# INLINEABLE makePassiveSet #-}+makePassiveSet :: forall params. Params params => Id params -> [Passive params] -> Maybe (PassiveSet params)+makePassiveSet _ [] = Nothing+makePassiveSet rule ps+  | and [passive_rule2 p == rule | p <- right] =+    mkPassiveSet proxy rule+      (Vector.fromList (map (pack True) (sort left)))+      (Vector.fromList (map (pack False) (sort right)))+  | otherwise = error "rule id does not occur in passive"+  where+    proxy :: Proxy params+    proxy = Proxy+    +    (left, right) = partition (\p -> passive_rule1 p == rule) ps+    pack isLeft Passive{..} =+      (packScore proxy passive_score,+       packId proxy (if isLeft then passive_rule2 else passive_rule1),+       fromIntegral passive_pos)++-- Find and remove the best element from a PassiveSet.+{-# INLINEABLE unconsPassiveSet #-}+unconsPassiveSet :: forall params. Params params => PassiveSet params -> (Passive params, Maybe (PassiveSet params))+unconsPassiveSet PassiveSet{..} =+  (passiveset_best, mkPassiveSet (Proxy :: Proxy params) passiveset_rule passiveset_left passiveset_right)++-- | A queued critical pair.+data Passive params =+  Passive {+    -- | The score of this critical pair.+    passive_score :: !(Score params),+    -- | The rule which does the outermost rewrite in this critical pair.+    passive_rule1 :: !(Id params),+    -- | The rule which does the innermost rewrite in this critical pair.+    passive_rule2 :: !(Id params),+    -- | The position of the overlap. See 'Twee.CP.overlap_pos'.+    passive_pos   :: {-# UNPACK #-} !Int }++instance Params params => Eq (Passive params) where+  x == y = compare x y == EQ++instance Params params => Ord (Passive params) where+  compare = comparing f+    where+      f Passive{..} =+        (passive_score,+         intMax (fromIntegral passive_rule1) (fromIntegral passive_rule2),+         intMin (fromIntegral passive_rule1) (fromIntegral passive_rule2),+         passive_pos)++-- | The empty queue.+empty :: Queue params+empty = Queue Heap.empty++-- | Add a set of 'Passive's to the queue.+{-# INLINEABLE insert #-}+insert :: Params params => Id params -> [Passive params] -> Queue params -> Queue params+insert rule passives (Queue q) =+  Queue $+  case makePassiveSet rule passives of+    Nothing -> q+    Just p -> Heap.insert p q++-- | Remove the minimum 'Passive' from the queue.+{-# INLINEABLE removeMin #-}+removeMin :: Params params => Queue params -> Maybe (Passive params, Queue params)+removeMin (Queue q) = do+  (passiveset, q) <- Heap.removeMin q+  case unconsPassiveSet passiveset of+    (passive, Just passiveset') ->+      Just (passive, Queue (Heap.insert passiveset' q))+    (passive, Nothing) ->+      Just (passive, Queue q)++-- | Map a function over all 'Passive's.+{-# INLINEABLE mapMaybe #-}+mapMaybe :: Params params => (Passive params -> Maybe (Passive params)) -> Queue params -> Queue params+mapMaybe f (Queue q) = Queue (Heap.mapMaybe g q)+  where+    g PassiveSet{..} =+      makePassiveSet passiveset_rule $ Data.Maybe.mapMaybe f $+        passiveset_best:+        map (unpack proxy passiveset_rule True) (Vector.toList passiveset_left) +++        map (unpack proxy passiveset_rule False) (Vector.toList passiveset_right)+    proxy :: Proxy params+    proxy = Proxy
+ Twee/Pretty.hs view
@@ -0,0 +1,182 @@+-- | Pretty-printing of terms and assorted other values.++{-# LANGUAGE Rank2Types #-}+module Twee.Pretty(module Twee.Pretty, module Text.PrettyPrint.HughesPJClass, Pretty(..)) where++import Text.PrettyPrint.HughesPJClass hiding (empty)+import qualified Text.PrettyPrint.HughesPJClass as PP+import qualified Data.Map as Map+import Data.Map(Map)+import qualified Data.Set as Set+import Data.Set(Set)+import Data.Ratio+import Twee.Term++-- * Miscellaneous 'Pretty' instances and utilities.++-- | Print a value to the console.+prettyPrint :: Pretty a => a -> IO ()+prettyPrint x = putStrLn (prettyShow x)++-- | The empty document. Used to avoid name clashes with 'Twee.Term.empty'.+pPrintEmpty :: Doc+pPrintEmpty = PP.empty++instance Pretty Doc where pPrint = id++-- | Print a tuple of values.+pPrintTuple :: [Doc] -> Doc+pPrintTuple = parens . fsep . punctuate comma++instance Pretty a => Pretty (Set a) where+  pPrint = pPrintSet . map pPrint . Set.toList++-- | Print a set of vlaues.+pPrintSet :: [Doc] -> Doc+pPrintSet = braces . fsep . punctuate comma++instance Pretty Var where+  pPrint (V n) =+    text $+      vars !! (n `mod` length vars):+      case n `div` length vars of+        0 -> ""+        m -> show (m+1)+    where+      vars = "XYZWVUTS"++instance (Pretty k, Pretty v) => Pretty (Map k v) where+  pPrint = pPrintSet . map binding . Map.toList+    where+      binding (x, v) = hang (pPrint x <+> text "=>") 2 (pPrint v)++instance (Eq a, Integral a, Pretty a) => Pretty (Ratio a) where+  pPrint a+    | denominator a == 1 = pPrint (numerator a)+    | otherwise = text "(" <+> pPrint (numerator a) <> text "/" <> pPrint (denominator a) <+> text ")"++-- | Generate a list of candidate names for pretty-printing.+supply :: [String] -> [String]+supply names =+  names +++  [ name ++ show i | i <- [2..], name <- names ]++-- * Pretty-printing of terms.++instance Pretty f => Pretty (Fun f) where+  pPrintPrec l p = pPrintPrec l p . fun_value++instance PrettyTerm f => PrettyTerm (Fun f) where+  termStyle f = termStyle (fun_value f)++instance PrettyTerm f => Pretty (Term f) where+  pPrintPrec l p (Var x) = pPrintPrec l p x+  pPrintPrec l p (App f xs) =+    pPrintTerm (termStyle f) l p (pPrint f) (unpack xs)++instance PrettyTerm f => Pretty (TermList f) where+  pPrintPrec _ _ = pPrint . unpack++instance PrettyTerm f => Pretty (Subst f) where+  pPrint sub = text "{" <> fsep (punctuate (text ",") docs) <> text "}"+    where+      docs =+        [ hang (pPrint x <+> text "->") 2 (pPrint t)+        | (x, t) <- substToList sub ]++-- | A class for customising the printing of function symbols.+class Pretty f => PrettyTerm f where+  -- | The style of the function symbol. Defaults to 'curried'.+  termStyle :: f -> TermStyle+  termStyle _ = curried++-- | Defines how to print out a function symbol.+newtype TermStyle =+  TermStyle {+    -- | Renders a function application.+    -- Takes the following arguments in this order:+    -- Pretty-printing level, current precedence,+    -- pretty-printed function symbol and list of arguments to the function.+    pPrintTerm :: forall a. Pretty a => PrettyLevel -> Rational -> Doc -> [a] -> Doc }++invisible, curried, uncurried, prefix, postfix :: TermStyle++-- | For operators like @$@ that should be printed as a blank space.+invisible =+  TermStyle $ \l p d ->+    let+      f [] = d+      f [t] = pPrintPrec l p t+      f (t:ts) =+        maybeParens (p > 10) $+          pPrint t <+>+            (hsep (map (pPrintPrec l 11) ts))+    in f++-- | For functions that should be printed curried.+curried =+  TermStyle $ \l p d ->+    let+      f [] = d+      f xs =+        maybeParens (p > 10) $+          d <+>+            (hsep (map (pPrintPrec l 11) xs))+    in f++-- | For functions that should be printed uncurried.+uncurried =+  TermStyle $ \l _ d ->+    let+      f [] = d+      f xs =+        d <> parens (hsep (punctuate comma (map (pPrintPrec l 0) xs)))+    in f++-- | A helper function that deals with under- and oversaturated applications.+fixedArity :: Int -> TermStyle -> TermStyle+fixedArity arity style =+  TermStyle $ \l p d ->+    let+      f xs+        | length xs < arity = pPrintTerm curried l p (parens d) xs+        | length xs > arity =+            maybeParens (p > 10) $+              hsep (pPrintTerm style l 11 d ys:+                    map (pPrintPrec l 11) zs)+        | otherwise = pPrintTerm style l p d xs+        where+          (ys, zs) = splitAt arity xs+    in f++-- | A helper function that drops a certain number of arguments.+implicitArguments :: Int -> TermStyle -> TermStyle+implicitArguments n (TermStyle pp) =+  TermStyle $ \l p d xs -> pp l p d (drop n xs)++-- | For prefix operators.+prefix =+  fixedArity 1 $+  TermStyle $ \l _ d [x] ->+    d <> pPrintPrec l 11 x++-- | For postfix operators.+postfix =+  fixedArity 1 $+  TermStyle $ \l _ d [x] ->+    pPrintPrec l 11 x <> d++-- | For infix operators.+infixStyle :: Int -> TermStyle+infixStyle pOp =+  fixedArity 2 $+  TermStyle $ \l p d [x, y] ->+    maybeParens (p > fromIntegral pOp) $+      pPrintPrec l (fromIntegral pOp+1) x <+> d <+>+      pPrintPrec l (fromIntegral pOp+1) y++-- | For tuples.+tupleStyle :: TermStyle+tupleStyle =+  TermStyle $ \l _ _ xs ->+    parens (hsep (punctuate comma (map (pPrintPrec l 0) xs)))
+ Twee/Proof.hs view
@@ -0,0 +1,723 @@+-- | Equational proofs which are checked for correctedness.+{-# LANGUAGE TypeFamilies, PatternGuards, RecordWildCards, ScopedTypeVariables #-}+module Twee.Proof(+  -- * Constructing proofs+  Proof, Derivation(..), Lemma(..), Axiom(..),+  certify, equation, derivation,+  -- ** Smart constructors for derivations+  lemma, axiom, symm, trans, cong, congPath,++  -- * Analysing proofs+  simplify, usedLemmas, usedAxioms, usedLemmasAndSubsts, usedAxiomsAndSubsts,++  -- * Pretty-printing proofs+  Config(..), defaultConfig, Presentation(..),+  ProvedGoal(..), provedGoal, checkProvedGoal,+  pPrintPresentation, present, describeEquation) where++import Twee.Base hiding (invisible)+import Twee.Equation+import Twee.Utils+import Control.Monad+import Data.Maybe+import Data.List+import Data.Ord+import qualified Data.Set as Set+import qualified Data.Map.Strict as Map++----------------------------------------------------------------------+-- Equational proofs. Only valid proofs can be constructed.+----------------------------------------------------------------------++-- | A checked proof. If you have a value of type @Proof f@,+-- it should jolly well represent a valid proof!+--+-- The only way to construct a @Proof f@ is by using 'certify'.+data Proof f =+  Proof {+    equation   :: !(Equation f),+    derivation :: !(Derivation f) }+  deriving (Eq, Show)++-- | A derivation is an unchecked proof. It might be wrong!+-- The way to check it is to call 'certify' to turn it into a 'Proof'.+data Derivation f =+    -- | Apply an existing rule (with proof!) to the root of a term+    UseLemma {-# UNPACK #-} !(Lemma f) !(Subst f)+    -- | Apply an axiom to the root of a term+  | UseAxiom {-# UNPACK #-} !(Axiom f) !(Subst f)+    -- | Reflexivity. @'Refl' t@ proves @t = t@.+  | Refl !(Term f)+    -- | Symmetry+  | Symm !(Derivation f)+    -- | Transivitity+  | Trans !(Derivation f) !(Derivation f)+    -- | Congruence.+    -- Parallel, i.e., takes a function symbol and one derivation for each+    -- argument of that function.+  | Cong {-# UNPACK #-} !(Fun f) ![Derivation f]+  deriving (Eq, Show)++-- | A lemma, which includes a proof.+data Lemma f =+  Lemma {+    -- | The id number of the lemma.+    -- Has no semantic meaning; for convenience only.+    lemma_id :: {-# UNPACK #-} !Id,+    -- | A proof of the lemma.+    lemma_proof :: !(Proof f) }+  deriving Show++--  | An axiom, which comes without proof.+data Axiom f =+  Axiom {+    -- | The number of the axiom.+    -- Has no semantic meaning; for convenience only.+    axiom_number :: {-# UNPACK #-} !Int,+    -- | A description of the axiom.+    -- Has no semantic meaning; for convenience only.+    axiom_name :: !String,+    -- | The equation which the axiom asserts.+    axiom_eqn :: !(Equation f) }+  deriving (Eq, Ord, Show)++-- | Checks a 'Derivation' and, if it is correct, returns a+-- certified 'Proof'.+--+-- If the 'Derivation' is incorrect, throws an exception.++-- This is the trusted core of the module.+{-# INLINEABLE certify #-}+certify :: PrettyTerm f => Derivation f -> Proof f+certify p =+  {-# SCC certify #-}+  case check p of+    Nothing -> error ("Invalid proof created!\n" ++ prettyShow p)+    Just eqn -> Proof eqn p+  where+    check (UseLemma Lemma{..} sub) =+      return (subst sub (equation lemma_proof))+    check (UseAxiom Axiom{..} sub) =+      return (subst sub axiom_eqn)+    check (Refl t) =+      return (t :=: t)+    check (Symm p) = do+      t :=: u <- check p+      return (u :=: t)+    check (Trans p q) = do+      t :=: u1 <- check p+      u2 :=: v <- check q+      guard (u1 == u2)+      return (t :=: v)+    check (Cong f ps) = do+      eqns <- mapM check ps+      return+        (build (app f (map eqn_lhs eqns)) :=:+         build (app f (map eqn_rhs eqns)))++----------------------------------------------------------------------+-- Everything below this point need not be trusted, since all proof+-- construction goes through the "proof" function.+----------------------------------------------------------------------++-- Typeclass instances.+instance Eq (Lemma f) where+  x == y = compare x y == EQ+instance Ord (Lemma f) where+  compare =+    comparing (\x ->+      -- Don't look into lemma proofs when comparing derivations,+      -- to avoid exponential blowup+      (lemma_id x, equation (lemma_proof x)))++instance Symbolic (Derivation f) where+  type ConstantOf (Derivation f) = f+  termsDL (UseLemma _ sub) = termsDL sub+  termsDL (UseAxiom _ sub) = termsDL sub+  termsDL (Refl t) = termsDL t+  termsDL (Symm p) = termsDL p+  termsDL (Trans p q) = termsDL p `mplus` termsDL q+  termsDL (Cong _ ps) = termsDL ps++  subst_ sub (UseLemma lemma s) = UseLemma lemma (subst_ sub s)+  subst_ sub (UseAxiom axiom s) = UseAxiom axiom (subst_ sub s)+  subst_ sub (Refl t) = Refl (subst_ sub t)+  subst_ sub (Symm p) = symm (subst_ sub p)+  subst_ sub (Trans p q) = trans (subst_ sub p) (subst_ sub q)+  subst_ sub (Cong f ps) = cong f (subst_ sub ps)++instance Function f => Pretty (Proof f) where+  pPrint = pPrintLemma defaultConfig prettyShow+instance PrettyTerm f => Pretty (Derivation f) where+  pPrint (UseLemma lemma sub) =+    text "subst" <> pPrintTuple [pPrint lemma, pPrint sub]+  pPrint (UseAxiom axiom sub) =+    text "subst" <> pPrintTuple [pPrint axiom, pPrint sub]+  pPrint (Refl t) =+    text "refl" <> pPrintTuple [pPrint t]+  pPrint (Symm p) =+    text "symm" <> pPrintTuple [pPrint p]+  pPrint (Trans p q) =+    text "trans" <> pPrintTuple [pPrint p, pPrint q]+  pPrint (Cong f ps) =+    text "cong" <> pPrintTuple (pPrint f:map pPrint ps)++instance PrettyTerm f => Pretty (Axiom f) where+  pPrint Axiom{..} =+    text "axiom" <>+    pPrintTuple [pPrint axiom_number, text axiom_name, pPrint axiom_eqn]++instance PrettyTerm f => Pretty (Lemma f) where+  pPrint Lemma{..} =+    text "lemma" <>+    pPrintTuple [pPrint lemma_id, pPrint (equation lemma_proof)]++-- | Simplify a derivation.+--+-- After simplification, a derivation has the following properties:+--+--   * 'Symm' is pushed down next to 'Lemma' and 'Axiom'+--   * 'Refl' only occurs inside 'Cong' or at the top level+--   * 'Trans' is right-associated and is pushed inside 'Cong' if possible+simplify :: Minimal f => (Lemma f -> Maybe (Derivation f)) -> Derivation f -> Derivation f+simplify lem p = simp p+  where+    simp p@(UseLemma lemma sub) =+      case lem lemma of+        Nothing -> p+        Just q ->+          let+            -- Get rid of any variables that are not bound by sub+            -- (e.g., ones which only occur internally in q)+            dead = usort (vars q) \\ substDomain sub+          in simp (subst sub (erase dead q))+    simp (Symm p) = symm (simp p)+    simp (Trans p q) = trans (simp p) (simp q)+    simp (Cong f ps) = cong f (map simp ps)+    simp p = p++lemma :: Lemma f -> Subst f -> Derivation f+lemma lem@Lemma{..} sub = UseLemma lem sub++axiom :: Axiom f -> Derivation f+axiom ax@Axiom{..} =+  UseAxiom ax $+    fromJust $+    listToSubst [(x, build (var x)) | x <- vars axiom_eqn]++symm :: Derivation f -> Derivation f+symm (Refl t) = Refl t+symm (Symm p) = p+symm (Trans p q) = trans (symm q) (symm p)+symm (Cong f ps) = cong f (map symm ps)+symm p = Symm p++trans :: Derivation f -> Derivation f -> Derivation f+trans Refl{} p = p+trans p Refl{} = p+trans (Trans p q) r =+  -- Right-associate uses of transitivity.+  -- p cannot be a Trans (if it was created with the smart+  -- constructors) but q could be.+  Trans p (trans q r)+-- Collect adjacent uses of congruence.+trans (Cong f ps) (Cong g qs) | f == g =+  transCong f ps qs+trans (Cong f ps) (Trans (Cong g qs) r) | f == g =+  trans (transCong f ps qs) r+trans p q = Trans p q++transCong :: Fun f -> [Derivation f] -> [Derivation f] -> Derivation f+transCong f ps qs =+  cong f (zipWith trans ps qs)++cong :: Fun f -> [Derivation f] -> Derivation f+cong f ps =+  case sequence (map unRefl ps) of+    Nothing -> Cong f ps+    Just ts -> Refl (build (app f ts))+  where+    unRefl (Refl t) = Just t+    unRefl _ = Nothing++-- | Find all lemmas which are used in a derivation.+usedLemmas :: Derivation f -> [Lemma f]+usedLemmas p = map fst (usedLemmasAndSubsts p)++-- | Find all lemmas which are used in a derivation,+-- together with the substitutions used.+usedLemmasAndSubsts :: Derivation f -> [(Lemma f, Subst f)]+usedLemmasAndSubsts p = lem p []+  where+    lem (UseLemma lemma sub) = ((lemma, sub):)+    lem (Symm p) = lem p+    lem (Trans p q) = lem p . lem q+    lem (Cong _ ps) = foldr (.) id (map lem ps)+    lem _ = id++-- | Find all axioms which are used in a derivation.+usedAxioms :: Derivation f -> [Axiom f]+usedAxioms p = map fst (usedAxiomsAndSubsts p)++-- | Find all axioms which are used in a derivation,+-- together with the substitutions used.+usedAxiomsAndSubsts :: Derivation f -> [(Axiom f, Subst f)]+usedAxiomsAndSubsts p = ax p []+  where+    ax (UseAxiom axiom sub) = ((axiom, sub):)+    ax (Symm p) = ax p+    ax (Trans p q) = ax p . ax q+    ax (Cong _ ps) = foldr (.) id (map ax ps)+    ax _ = id++-- | Applies a derivation at a particular path in a term.+congPath :: [Int] -> Term f -> Derivation f -> Derivation f+congPath [] _ p = p+congPath (n:ns) (App f t) p | n <= length ts =+  cong f $+    map Refl (take n ts) +++    [congPath ns (ts !! n) p] +++    map Refl (drop (n+1) ts)+  where+    ts = unpack t+congPath _ _ _ = error "bad path"++----------------------------------------------------------------------+-- Pretty-printing of proofs.+----------------------------------------------------------------------++-- | Options for proof presentation.+data Config =+  Config {+    -- | Never inline lemmas.+    cfg_all_lemmas :: !Bool,+    -- | Inline all lemmas.+    cfg_no_lemmas :: !Bool,+    -- | Print out explicit substitutions.+    cfg_show_instances :: !Bool }++-- | The default configuration.+defaultConfig :: Config+defaultConfig =+  Config {+    cfg_all_lemmas = False,+    cfg_no_lemmas = False,+    cfg_show_instances = False }++-- | A proof, with all axioms and lemmas explicitly listed.+data Presentation f =+  Presentation {+    -- | The used axioms.+    pres_axioms :: [Axiom f],+    -- | The used lemmas.+    pres_lemmas :: [Lemma f],+    -- | The goals proved.+    pres_goals  :: [ProvedGoal f] }+  deriving Show++-- Note: only the pg_proof field should be trusted!+-- The remaining fields are for information only.+data ProvedGoal f =+  ProvedGoal {+    pg_number  :: Int,+    pg_name    :: String,+    pg_proof   :: Proof f,++    -- Extra fields for existentially-quantified goals, giving the original goal+    -- and the existential witness. These fields are not verified. If you want+    -- to check them, use checkProvedGoal.+    --+    -- In general, subst pg_witness_hint pg_goal_hint == equation pg_proof.+    -- For non-existential goals, pg_goal_hint == equation pg_proof+    -- and pg_witness_hint is the empty substitution.+    pg_goal_hint    :: Equation f,+    pg_witness_hint :: Subst f }+  deriving Show++-- | Construct a @ProvedGoal@.+provedGoal :: Int -> String -> Proof f -> ProvedGoal f+provedGoal number name proof =+  ProvedGoal {+    pg_number = number,+    pg_name = name,+    pg_proof = proof,+    pg_goal_hint = equation proof,+    pg_witness_hint = emptySubst }++-- | Check that pg_goal/pg_witness match up with pg_proof.+checkProvedGoal :: Function f => ProvedGoal f -> ProvedGoal f+checkProvedGoal pg@ProvedGoal{..}+  | subst pg_witness_hint pg_goal_hint == equation pg_proof =+    pg+  | otherwise =+    error $ show $+      text "Invalid ProvedGoal!" $$+      text "Claims to prove" <+> pPrint pg_goal_hint $$+      text "with witness" <+> pPrint pg_witness_hint <> text "," $$+      text "but actually proves" <+> pPrint (equation pg_proof)++instance Function f => Pretty (Presentation f) where+  pPrint = pPrintPresentation defaultConfig++-- | Simplify and present a proof.+present :: Function f => Config -> [ProvedGoal f] -> Presentation f+present config goals =+  -- First find all the used lemmas, then hand off to presentWithGoals+  presentWithGoals config goals+    (used Set.empty (concatMap (usedLemmas . derivation . pg_proof) goals))+  where+    used lems [] = Set.elems lems+    used lems (x:xs)+      | x `Set.member` lems = used lems xs+      | otherwise =+        used (Set.insert x lems)+          (usedLemmas (derivation (lemma_proof x)) ++ xs)++presentWithGoals ::+  Function f =>+  Config -> [ProvedGoal f] -> [Lemma f] -> Presentation f+presentWithGoals config@Config{..} goals lemmas+  -- We inline a lemma if one of the following holds:+  --   * It only has one step+  --   * It is subsumed by an earlier lemma+  --   * It is only used once+  --   * It has to do with $equals (for printing of the goal proof)+  --   * The option cfg_no_lemmas is true+  -- First we compute all inlinings, then apply simplify to remove them,+  -- then repeat if any lemma was inlined+  | Map.null inlinings =+    let+      axioms = usort $+        concatMap (usedAxioms . derivation . pg_proof) goals +++        concatMap (usedAxioms . derivation . lemma_proof) lemmas+    in+      Presentation axioms+        [ lemma { lemma_proof = flattenProof lemma_proof }+        | lemma@Lemma{..} <- lemmas ]+        [ decodeGoal (goal { pg_proof = flattenProof pg_proof })+        | goal@ProvedGoal{..} <- goals ]++  | otherwise =+    let+      inline lemma = Map.lookup lemma inlinings++      goals' =+        [ decodeGoal (goal { pg_proof = certify $ simplify inline (derivation pg_proof) })+        | goal@ProvedGoal{..} <- goals ]+      lemmas' =+        [ Lemma n (certify $ simplify inline (derivation p))+        | lemma@(Lemma n p) <- lemmas, not (lemma `Map.member` inlinings) ]+    in+      presentWithGoals config goals' lemmas'++  where+    inlinings =+      Map.fromList+        [ (lemma, p)+        | lemma <- lemmas, Just p <- [tryInline lemma]]++    tryInline (Lemma n p)+      | shouldInline n p = Just (derivation p)+    tryInline (Lemma n p)+      -- Check for subsumption by an earlier lemma+      | Just (Lemma m q) <- Map.lookup (canonicalise (t :=: u)) equations, m < n =+        Just (subsume p (derivation q))+      | Just (Lemma m q) <- Map.lookup (canonicalise (u :=: t)) equations, m < n =+        Just (subsume p (Symm (derivation q)))+      where+        t :=: u = equation p+    tryInline _ = Nothing++    shouldInline n p =+      cfg_no_lemmas ||+      oneStep (derivation p) ||+      (not cfg_all_lemmas &&+       (isJust (decodeEquality (eqn_lhs (equation p))) ||+        isJust (decodeEquality (eqn_rhs (equation p))) ||+        Map.lookup n uses == Just 1))+  +    subsume p q =+      -- Rename q so its variables match p's+      subst sub q+      where+        t  :=: u  = equation p+        t' :=: u' = equation (certify q)+        Just sub  = matchList (buildList [t', u']) (buildList [t, u])++    -- Record which lemma proves each equation+    equations =+      Map.fromList+        [ (canonicalise (equation lemma_proof), lemma)+        | lemma@Lemma{..} <- lemmas]++    -- Count how many times each lemma is used+    uses =+      Map.fromListWith (+)+        [ (lemma_id, 1)+        | Lemma{..} <-+            concatMap usedLemmas+              (map (derivation . pg_proof) goals +++               map (derivation . lemma_proof) lemmas) ]++    -- Check if a proof only has one step.+    -- Trans only occurs at the top level by this point.+    oneStep Trans{} = False+    oneStep _ = True++invisible :: Function f => Equation f -> Bool+invisible (t :=: u) = show (pPrint t) == show (pPrint u)++-- Pretty-print the proof of a single lemma.+pPrintLemma :: Function f => Config -> (Id -> String) -> Proof f -> Doc+pPrintLemma Config{..} lemmaName p =+  ppTerm (eqn_lhs (equation q)) $$ pp (derivation q)+  where+    q = flattenProof p++    pp (Trans p q) = pp p $$ pp q+    pp p | invisible (equation (certify p)) = pPrintEmpty+    pp p =+      (text "= { by" <+>+       ppStep+         (nub (map (show . ppLemma) (usedLemmasAndSubsts p)) +++          nub (map (show . ppAxiom) (usedAxiomsAndSubsts p))) <+>+       text "}" $$+       ppTerm (eqn_rhs (equation (certify p))))++    ppTerm t = text "  " <> pPrint t++    ppStep [] = text "reflexivity" -- ??+    ppStep [x] = text x+    ppStep xs =+      hcat (punctuate (text ", ") (map text (init xs))) <+>+      text "and" <+>+      text (last xs)++    ppLemma (Lemma{..}, sub) =+      text "lemma" <+> text (lemmaName lemma_id) <> showSubst sub+    ppAxiom (Axiom{..}, sub) =+      text "axiom" <+> pPrint axiom_number <+> parens (text axiom_name) <> showSubst sub++    showSubst sub+      | cfg_show_instances && not (null (substToList sub)) =+        text " with " <>+        fsep (punctuate comma+          [ pPrint x <+> text "->" <+> pPrint t+          | (x, t) <- substToList sub ])+      | otherwise = pPrintEmpty++-- Transform a proof so that each step uses exactly one axiom+-- or lemma. The proof will have the following form afterwards:+--   * Trans only occurs at the outermost level and is right-associated+--   * Each Cong has exactly one non-Refl argument (no parallel rewriting)+--   * Symm only occurs innermost, i.e., next to UseLemma or UseAxiom+--   * Refl only occurs as an argument to Cong, or outermost if the+--     whole proof is a single reflexivity step+flattenProof :: Function f => Proof f -> Proof f+flattenProof =+  certify . flat . simplify (const Nothing) . derivation+  where+    flat (Trans p q) = trans (flat p) (flat q)+    flat p@(Cong f ps) =+      foldr trans (reflAfter p)+        [ Cong f $+            map reflAfter (take i ps) +++            [p] +++            map reflBefore (drop (i+1) ps)+        | (i, q) <- zip [0..] qs,+          p <- steps q ]+      where+        qs = map flat ps+    flat p = p++    reflBefore p = Refl (eqn_lhs (equation (certify p)))+    reflAfter p  = Refl (eqn_rhs (equation (certify p)))++    steps Refl{} = []+    steps (Trans p q) = steps p ++ steps q+    steps p = [p]++    trans (Trans p q) r = trans p (trans q r)+    trans Refl{} p = p+    trans p Refl{} = p+    trans p q =+      case strip q of+        Nothing -> Trans p q+        Just q' -> trans p q'++    strip p+      | t == u = Just (Refl t)+      | otherwise = strip' t p+      where+        t :=: u = equation (certify p)+    strip' t (Trans _ q)+      | eqn_lhs (equation (certify q)) == t = Just q+      | otherwise = strip' t q+    strip' _ _ = Nothing++-- Transform a derivation into a list of single steps.+-- Each step has the following form:+--   * Trans does not occur+--   * Symm only occurs innermost, i.e., next to UseLemma or UseAxiom+--   * Each Cong has exactly one non-Refl argument (no parallel rewriting)+--   * Refl only occurs as an argument to Cong+derivSteps :: Function f => Derivation f -> [Derivation f]+derivSteps = steps . derivation . flattenProof . certify+  where+    steps Refl{} = []+    steps (Trans p q) = steps p ++ steps q+    steps p = [p]++-- | Print a presented proof.+pPrintPresentation :: forall f. Function f => Config -> Presentation f -> Doc+pPrintPresentation config (Presentation axioms lemmas goals) =+  vcat $ intersperse (text "") $+    vcat [ describeEquation "Axiom" (show n) (Just name) eqn+         | Axiom n name eqn <- axioms,+           not (invisible eqn) ]:+    [ pp "Lemma" (num n) Nothing (equation p) emptySubst p+    | Lemma n p <- lemmas,+      not (invisible (equation p)) ] +++    [ pp "Goal" (show num) (Just pg_name) pg_goal_hint pg_witness_hint pg_proof+    | (num, ProvedGoal{..}) <- zip [1..] goals ]+  where+    pp kind n mname eqn witness p =+      describeEquation kind n mname eqn $$+      ppWitness witness $$+      text "Proof:" $$+      pPrintLemma config num p++    num x = show (fromJust (Map.lookup x nums))+    nums = Map.fromList (zip (map lemma_id lemmas) [n+1 ..])+    n = maximum $ 0:map axiom_number axioms++    ppWitness sub+      | sub == emptySubst = pPrintEmpty+      | otherwise =+          vcat [+            text "The goal is true when:",+            nest 2 $ vcat+              [ pPrint x <+> text "=" <+> pPrint t+              | (x, t) <- substToList sub ],+            if minimal `elem` funs sub then+              text "where" <+> doubleQuotes (pPrint (minimal :: Fun f)) <+>+              text "stands for an arbitrary term of your choice."+            else pPrintEmpty,+            text ""]++-- | Format an equation nicely.+--+-- Used both here and in the main file.+describeEquation ::+  PrettyTerm f =>+  String -> String -> Maybe String -> Equation f -> Doc+describeEquation kind num mname eqn =+  text kind <+> text num <>+  (case mname of+     Nothing -> text ""+     Just name -> text (" (" ++ name ++ ")")) <>+  text ":" <+> pPrint eqn <> text "."++----------------------------------------------------------------------+-- Making proofs of existential goals more readable.+----------------------------------------------------------------------++-- The idea: the only axioms which mention $equals, $true and $false+-- are:+--   * $equals(x,x) = $true  (reflexivity)+--   * $equals(t,u) = $false (conjecture)+-- This implies that a proof $true = $false must have the following+-- structure, if we expand out all lemmas:+--   $true = $equals(s,s) = ... = $equals(t,u) = $false.+--+-- The substitution in the last step $equals(t,u) = $false is in fact the+-- witness to the existential.+--+-- Furthermore, we can make it so that the inner "..." doesn't use the $equals+-- axioms. If it does, one of the "..." steps results in either $true or $false,+-- and we can chop off everything before the $true or after the $false.+--+-- Once we have done that, every proof step in the "..." must be a congruence+-- step of the shape+--   $equals(t, u) = $equals(v, w).+-- This is because there are no other axioms which mention $equals. Hence we can+-- split the proof of $equals(s,s) = $equals(t,u) into separate proofs of s=t+-- and s=u.+--+-- What we have got out is:+--   * the witness to the existential+--   * a proof that both sides of the conjecture are equal+-- and we can present that to the user.++-- Decode $equals(t,u) into an equation t=u.+decodeEquality :: Function f => Term f -> Maybe (Equation f)+decodeEquality (App equals (Cons t (Cons u Empty)))+  | isEquals equals = Just (t :=: u)+decodeEquality _ = Nothing++-- Tries to transform a proof of $true = $false into a proof of+-- the original existentially-quantified formula.+decodeGoal :: Function f => ProvedGoal f -> ProvedGoal f+decodeGoal pg =+  case maybeDecodeGoal pg of+    Nothing -> pg+    Just (name, witness, goal, deriv) ->+      checkProvedGoal $+      pg {+        pg_name = name,+        pg_proof = certify deriv,+        pg_goal_hint = goal,+        pg_witness_hint = witness }++maybeDecodeGoal :: forall f. Function f =>+  ProvedGoal f -> Maybe (String, Subst f, Equation f, Derivation f)+maybeDecodeGoal ProvedGoal{..}+  --  N.B. presentWithGoals takes care of expanding any lemma which mentions+  --  $equals, and flattening the proof.+  | isFalseTerm u = extract (derivSteps deriv)+    -- Orient the equation so that $false is the RHS.+  | isFalseTerm t = extract (derivSteps (symm deriv))+  | otherwise = Nothing+  where+    isFalseTerm, isTrueTerm :: Term f -> Bool+    isFalseTerm (App false _) = isFalse false+    isFalseTerm _ = False+    isTrueTerm (App true _) = isTrue true+    isTrueTerm _ = False++    t :=: u = equation pg_proof+    deriv = derivation pg_proof++    -- Detect $true = $equals(t, t).+    decodeReflexivity :: Derivation f -> Maybe (Term f)+    decodeReflexivity (Symm (UseAxiom Axiom{..} sub)) = do+      guard (isTrueTerm (eqn_rhs axiom_eqn))+      (t :=: u) <- decodeEquality (eqn_lhs axiom_eqn)+      guard (t == u)+      return (subst sub t)+    decodeReflexivity _ = Nothing++    -- Detect $equals(t, u) = $false.+    decodeConjecture :: Derivation f -> Maybe (String, Equation f, Subst f)+    decodeConjecture (UseAxiom Axiom{..} sub) = do+      guard (isFalseTerm (eqn_rhs axiom_eqn))+      eqn <- decodeEquality (eqn_lhs axiom_eqn)+      return (axiom_name, eqn, sub)+    decodeConjecture _ = Nothing++    extract (p:ps) = do+      -- Start by finding $true = $equals(t,u).+      t <- decodeReflexivity p+      cont (Refl t) (Refl t) ps+    extract [] = Nothing++    cont p1 p2 (p:ps)+      | Just t <- decodeReflexivity p =+        cont (Refl t) (Refl t) ps+      | Just (name, eqn, sub) <- decodeConjecture p =+        -- If p1: s=t and p2: s=u+        -- then symm p1 `trans` p2: t=u.+        return (name, sub, eqn, symm p1 `trans` p2)+      | Cong eq [p1', p2'] <- p, isEquals eq =+        cont (p1 `trans` p1') (p2 `trans` p2') ps+    cont _ _ _ = Nothing
+ Twee/Rule.hs view
@@ -0,0 +1,488 @@+-- | Term rewriting.+{-# LANGUAGE TypeFamilies, FlexibleContexts, RecordWildCards, BangPatterns, OverloadedStrings, MultiParamTypeClasses, ScopedTypeVariables, GeneralizedNewtypeDeriving #-}+module Twee.Rule where++import Twee.Base+import Twee.Constraints+import qualified Twee.Index as Index+import Twee.Index(Index)+import Control.Monad+import Control.Monad.Trans.Class+import Control.Monad.Trans.State.Strict+import Data.Maybe+import Data.List+import Twee.Utils+import qualified Data.Set as Set+import Data.Set(Set)+import qualified Twee.Term as Term+import Data.Ord+import Twee.Equation+import qualified Twee.Proof as Proof+import Twee.Proof(Derivation, Lemma(..))+import Data.Tuple++--------------------------------------------------------------------------------+-- * Rewrite rules.+--------------------------------------------------------------------------------++-- | A rewrite rule.+data Rule f =+  Rule {+    -- | Information about whether and how the rule is oriented.+    orientation :: !(Orientation f),+    -- Invariant:+    -- For oriented rules: vars rhs `isSubsetOf` vars lhs+    -- For unoriented rules: vars lhs == vars rhs++    -- | The left-hand side of the rule.+    lhs :: {-# UNPACK #-} !(Term f),+    -- | The right-hand side of the rule.+    rhs :: {-# UNPACK #-} !(Term f) }+  deriving (Eq, Ord, Show)+type RuleOf a = Rule (ConstantOf a)++-- | A rule's orientation.+--+-- 'Oriented' and 'WeaklyOriented' rules are used only left-to-right.+-- 'Permutative' and 'Unoriented' rules are used bidirectionally.+data Orientation f =+    -- | An oriented rule.+    Oriented+    -- | A weakly oriented rule.+    -- The first argument is the minimal constant, the second argument is a list+    -- of terms which are weakly oriented in the rule.+    -- +    -- A rule with orientation @'WeaklyOriented' k ts@ can be used unless+    -- all terms in @ts@ are equal to @k@.+  | WeaklyOriented {-# UNPACK #-} !(Fun f) [Term f]+    -- | A permutative rule.+    --+    -- A rule with orientation @'Permutative' ts@ can be used if+    -- @map fst ts@ is lexicographically greater than @map snd ts@.+  | Permutative [(Term f, Term f)]+    -- | An unoriented rule.+  | Unoriented+  deriving Show++instance Eq (Orientation f) where _ == _ = True+instance Ord (Orientation f) where compare _ _ = EQ++-- | Is a rule oriented or weakly oriented?+oriented :: Orientation f -> Bool+oriented Oriented{} = True+oriented WeaklyOriented{} = True+oriented _ = False++-- | Is a rule weakly oriented?+weaklyOriented :: Orientation f -> Bool+weaklyOriented WeaklyOriented{} = True+weaklyOriented _ = False++instance Symbolic (Rule f) where+  type ConstantOf (Rule f) = f+  termsDL (Rule or t u) = termsDL or `mplus` termsDL t `mplus` termsDL u+  subst_ sub (Rule or t u) = Rule (subst_ sub or) (subst_ sub t) (subst_ sub u)++instance f ~ g => Has (Rule f) (Term g) where+  the = lhs++instance Symbolic (Orientation f) where+  type ConstantOf (Orientation f) = f++  termsDL Oriented = mzero+  termsDL (WeaklyOriented _ ts) = termsDL ts+  termsDL (Permutative ts) = termsDL ts+  termsDL Unoriented = mzero++  subst_ _   Oriented = Oriented+  subst_ sub (WeaklyOriented min ts) = WeaklyOriented min (subst_ sub ts)+  subst_ sub (Permutative ts) = Permutative (subst_ sub ts)+  subst_ _   Unoriented = Unoriented++instance PrettyTerm f => Pretty (Rule f) where+  pPrint (Rule or l r) =+    pPrint l <+> text (showOrientation or) <+> pPrint r+    where+      showOrientation Oriented = "->"+      showOrientation WeaklyOriented{} = "~>"+      showOrientation Permutative{} = "<->"+      showOrientation Unoriented = "="++-- | Turn a rule into an equation.+unorient :: Rule f -> Equation f+unorient (Rule _ l r) = l :=: r++-- | Turn an equation t :=: u into a rule t -> u by computing the+-- orientation info (e.g. oriented, permutative or unoriented).+--+-- Crashes if t -> u is not a valid rule, for example if there is+-- a variable in @u@ which is not in @t@. To prevent this happening,+-- combine with 'Twee.CP.split'.+orient :: Function f => Equation f -> Rule f+orient (t :=: u) = Rule o t u+  where+    o | lessEq u t =+        case unify t u of+          Nothing -> Oriented+          Just sub+            | allSubst (\_ (Cons t Empty) -> isMinimal t) sub ->+              WeaklyOriented minimal (map (build . var . fst) (substToList sub))+            | otherwise -> Unoriented+      | lessEq t u = error "wrongly-oriented rule"+      | not (null (usort (vars u) \\ usort (vars t))) =+        error "unbound variables in rule"+      | Just ts <- evalStateT (makePermutative t u) [],+        permutativeOK t u ts =+        Permutative ts+      | otherwise = Unoriented++    permutativeOK _ _ [] = True+    permutativeOK t u ((Var x, Var y):xs) =+      lessIn model u t == Just Strict &&+      permutativeOK t' u' xs+      where+        model = modelFromOrder [Variable y, Variable x]+        sub x' = if x == x' then var y else var x'+        t' = subst sub t+        u' = subst sub u++    makePermutative t u = do+      msub <- gets listToSubst+      sub  <- lift msub+      aux (subst sub t) (subst sub u)+        where+          aux (Var x) (Var y)+            | x == y = return []+            | otherwise = do+              modify ((x, build $ var y):)+              return [(build $ var x, build $ var y)]++          aux (App f ts) (App g us)+            | f == g =+              fmap concat (zipWithM makePermutative (unpack ts) (unpack us))++          aux _ _ = mzero++-- | Flip an unoriented rule so that it goes right-to-left.+backwards :: Rule f -> Rule f+backwards (Rule or t u) = Rule (back or) u t+  where+    back (Permutative xs) = Permutative (map swap xs)+    back Unoriented = Unoriented+    back _ = error "Can't turn oriented rule backwards"++--------------------------------------------------------------------------------+-- * Extra-fast rewriting, without proof output or unorientable rules.+--------------------------------------------------------------------------------++-- | Compute the normal form of a term wrt only oriented rules.+{-# INLINEABLE simplify #-}+simplify :: (Function f, Has a (Rule f)) => Index f a -> Term f -> Term f+simplify !idx !t = {-# SCC simplify #-} simplify1 idx t++{-# INLINEABLE simplify1 #-}+simplify1 :: (Function f, Has a (Rule f)) => Index f a -> Term f -> Term f+simplify1 idx t+  | t == u = t+  | otherwise = simplify idx u+  where+    u = build (simp (singleton t))++    simp Empty = mempty+    simp (Cons (Var x) t) = var x `mappend` simp t+    simp (Cons t u)+      | Just (rule, sub) <- simpleRewrite idx t =+        Term.subst sub (rhs rule) `mappend` simp u+    simp (Cons (App f ts) us) =+      app f (simp ts) `mappend` simp us++-- | Check if a term can be simplified.+{-# INLINEABLE canSimplify #-}+canSimplify :: (Function f, Has a (Rule f)) => Index f a -> Term f -> Bool+canSimplify idx t = canSimplifyList idx (singleton t)++{-# INLINEABLE canSimplifyList #-}+canSimplifyList :: (Function f, Has a (Rule f)) => Index f a -> TermList f -> Bool+canSimplifyList idx t =+  {-# SCC canSimplifyList #-}+  any (isJust . simpleRewrite idx) (filter isApp (subtermsList t))++-- | Find a simplification step that applies to a term.+{-# INLINEABLE simpleRewrite #-}+simpleRewrite :: (Function f, Has a (Rule f)) => Index f a -> Term f -> Maybe (Rule f, Subst f)+simpleRewrite idx t =+  -- Use instead of maybeToList to make fusion work+  foldr (\x _ -> Just x) Nothing $ do+    rule <- the <$> Index.approxMatches t idx+    guard (oriented (orientation rule))+    sub <- maybeToList (match (lhs rule) t)+    guard (reducesOriented rule sub)+    return (rule, sub)++--------------------------------------------------------------------------------+-- * Rewriting, with proof output.+--------------------------------------------------------------------------------++-- | A strategy gives a set of possible reductions for a term.+type Strategy f = Term f -> [Reduction f]++-- | A multi-step rewrite proof @t ->* u@+data Reduction f =+    -- | Apply a single rewrite rule to the root of a term+    Step {-# UNPACK #-} !(Lemma f) !(Rule f) !(Subst f)+    -- | Reflexivity+  | Refl {-# UNPACK #-} !(Term f)+    -- | Transivitity+  | Trans !(Reduction f) !(Reduction f)+    -- | Congruence+  | Cong {-# UNPACK #-} !(Fun f) ![Reduction f]+  deriving Show++instance Symbolic (Reduction f) where+  type ConstantOf (Reduction f) = f+  termsDL (Step _ _ sub) = termsDL sub+  termsDL (Refl t) = termsDL t+  termsDL (Trans p q) = termsDL p `mplus` termsDL q+  termsDL (Cong _ ps) = termsDL ps++  subst_ sub (Step lemma rule s) = Step lemma rule (subst_ sub s)+  subst_ sub (Refl t) = Refl (subst_ sub t)+  subst_ sub (Trans p q) = Trans (subst_ sub p) (subst_ sub q)+  subst_ sub (Cong f ps) = Cong f (subst_ sub ps)++instance Function f => Pretty (Reduction f) where+  pPrint = pPrint . reductionProof++-- | A smart constructor for Trans which simplifies Refl.+trans :: Reduction f -> Reduction f -> Reduction f+trans Refl{} p = p+trans p Refl{} = p+-- Make right-associative to improve performance of 'result'+trans p (Trans q r) = Trans (Trans p q) r+trans p q = Trans p q++-- | A smart constructor for Cong which simplifies Refl.+cong :: Fun f -> [Reduction f] -> Reduction f+cong f ps+  | all isRefl ps = Refl (result (reduce (Cong f ps)))+  | otherwise = Cong f ps+  where+    isRefl Refl{} = True+    isRefl _ = False++-- | The list of all rewrite rules used in a rewrite proof.+steps :: Reduction f -> [Reduction f]+steps r = aux r []+  where+    aux step@Step{} = (step:)+    aux (Refl _) = id+    aux (Trans p q) = aux p . aux q+    aux (Cong _ ps) = foldr (.) id (map aux ps)++-- | Turn a reduction into a proof.+reductionProof :: Reduction f -> Derivation f+reductionProof (Step lemma _ sub) =+  Proof.lemma lemma sub+reductionProof (Refl t) = Proof.Refl t+reductionProof (Trans p q) =+  Proof.trans (reductionProof p) (reductionProof q)+reductionProof (Cong f ps) = Proof.cong f (map reductionProof ps)++-- | Construct a basic rewrite step.+{-# INLINE step #-}+step :: (Has a (Rule f), Has a (Lemma f)) => a -> Subst f -> Reduction f+step x sub = Step (the x) (the x) sub++----------------------------------------------------------------------+-- | A rewrite proof with the final term attached.+-- Has an @Ord@ instance which compares the final term.+----------------------------------------------------------------------++data Resulting f =+  Resulting {+    result :: {-# UNPACK #-} !(Term f),+    reduction :: !(Reduction f) }+  deriving Show++instance Eq (Resulting f) where x == y = compare x y == EQ+instance Ord (Resulting f) where compare = comparing result++instance Symbolic (Resulting f) where+  type ConstantOf (Resulting f) = f+  termsDL (Resulting t red) =+    termsDL t `mplus` termsDL red+  subst_ sub (Resulting t red) =+    Resulting (subst_ sub t) (subst_ sub red)++instance Function f => Pretty (Resulting f) where+  pPrint = pPrint . reduction++-- | Construct a 'Resulting' from a 'Reduction'.+reduce :: Reduction f -> Resulting f+reduce p =+  Resulting (res p) p+  where+    res (Trans _ q) = res q+    res (Refl t) = t+    res p = {-# SCC res_emitRes #-} build (emitResult p)++    emitResult (Step _ r sub) = Term.subst sub (rhs r)+    emitResult (Refl t) = builder t+    emitResult (Trans _ q) = emitResult q+    emitResult (Cong f ps) = app f (map emitResult ps)++--------------------------------------------------------------------------------+-- * Strategy combinators.+--------------------------------------------------------------------------------++-- | Normalise a term wrt a particular strategy.+{-# INLINE normaliseWith #-}+normaliseWith :: Function f => (Term f -> Bool) -> Strategy f -> Term f -> Resulting f+normaliseWith ok strat t = {-# SCC normaliseWith #-} res+  where+    res = aux 0 (Refl t) t+    aux 1000 p _ =+      error $+        "Possibly nonterminating rewrite:\n" ++ prettyShow p+    aux n p t =+      case parallel strat t of+        (q:_) | u <- result (reduce q), ok u ->+          aux (n+1) (p `trans` q) u+        _ -> Resulting t p++-- | Compute all normal forms of a set of terms wrt a particular strategy.+normalForms :: Function f => Strategy f -> [Resulting f] -> Set (Resulting f)+normalForms strat ps = snd (successorsAndNormalForms strat ps)++-- | Compute all successors of a set of terms (a successor of a term @t@+-- is a term @u@ such that @t ->* u@).+successors :: Function f => Strategy f -> [Resulting f] -> Set (Resulting f)+successors strat ps = Set.union qs rs+  where+    (qs, rs) = successorsAndNormalForms strat ps++{-# INLINEABLE successorsAndNormalForms #-}+successorsAndNormalForms :: Function f => Strategy f -> [Resulting f] ->+  (Set (Resulting f), Set (Resulting f))+successorsAndNormalForms strat ps =+  {-# SCC successorsAndNormalForms #-} go Set.empty Set.empty ps+  where+    go dead norm [] = (dead, norm)+    go dead norm (p:ps)+      | p `Set.member` dead = go dead norm ps+      | p `Set.member` norm = go dead norm ps+      | null qs = go dead (Set.insert p norm) ps+      | otherwise =+        go (Set.insert p dead) norm (qs ++ ps)+      where+        qs =+          [ reduce (reduction p `Trans` q)+          | q <- anywhere strat (result p) ]++-- | Apply a strategy anywhere in a term.+anywhere :: Strategy f -> Strategy f+anywhere strat t = strat t ++ nested (anywhere strat) t++-- | Apply a strategy to some child of the root function.+nested :: Strategy f -> Strategy f+nested _ Var{} = []+nested strat (App f ts) =+  cong f <$> inner [] ts+  where+    inner _ Empty = []+    inner before (Cons t u) =+      [ reverse before ++ [p] ++ map Refl (unpack u)+      | p <- strat t ] +++      inner (Refl t:before) u++-- | Apply a strategy in parallel in as many places as possible.+-- Takes only the first rewrite of each strategy.+{-# INLINE parallel #-}+parallel :: PrettyTerm f => Strategy f -> Strategy f+parallel strat t =+  case par t of+    Refl{} -> []+    p -> [p]+  where+    par t | p:_ <- strat t = p+    par (App f ts) = cong f (inner [] ts)+    par t = Refl t++    inner before Empty = reverse before+    inner before (Cons t u) = inner (par t:before) u++--------------------------------------------------------------------------------+-- * Basic strategies. These only apply at the root of the term.+--------------------------------------------------------------------------------++-- | A strategy which rewrites using an index.+{-# INLINE rewrite #-}+rewrite :: (Function f, Has a (Rule f), Has a (Lemma f)) => (Rule f -> Subst f -> Bool) -> Index f a -> Strategy f+rewrite p rules t = do+  rule <- Index.approxMatches t rules+  tryRule p rule t++-- | A strategy which applies one rule only.+{-# INLINEABLE tryRule #-}+tryRule :: (Function f, Has a (Rule f), Has a (Lemma f)) => (Rule f -> Subst f -> Bool) -> a -> Strategy f+tryRule p rule t = do+  sub <- maybeToList (match (lhs (the rule)) t)+  guard (p (the rule) sub)+  return (step rule sub)++-- | Check if a rule can be applied, given an ordering <= on terms.+{-# INLINEABLE reducesWith #-}+reducesWith :: Function f => (Term f -> Term f -> Bool) -> Rule f -> Subst f -> Bool+reducesWith _ (Rule Oriented _ _) _ = True+reducesWith _ (Rule (WeaklyOriented min ts) _ _) sub =+  -- Be a bit careful here not to build new terms+  -- (reducesWith is used in simplify).+  -- This is the same as:+  --   any (not . isMinimal) (subst sub ts)+  any (not . isMinimal . expand) ts+  where+    expand t@(Var x) = fromMaybe t (Term.lookup x sub)+    expand t = t++    isMinimal (App f Empty) = f == min+    isMinimal _ = False+reducesWith p (Rule (Permutative ts) _ _) sub =+  aux ts+  where+    aux [] = False+    aux ((t, u):ts)+      | t' == u' = aux ts+      | otherwise = p u' t'+      where+        t' = subst sub t+        u' = subst sub u+reducesWith p (Rule Unoriented t u) sub =+  p u' t' && u' /= t'+  where+    t' = subst sub t+    u' = subst sub u++-- | Check if a rule can be applied normally.+{-# INLINEABLE reduces #-}+reduces :: Function f => Rule f -> Subst f -> Bool+reduces rule sub = reducesWith lessEq rule sub++-- | Check if a rule can be applied and is oriented.+{-# INLINEABLE reducesOriented #-}+reducesOriented :: Function f => Rule f -> Subst f -> Bool+reducesOriented rule sub =+  oriented (orientation rule) && reducesWith undefined rule sub++-- | Check if a rule can be applied in a particular model.+{-# INLINEABLE reducesInModel #-}+reducesInModel :: Function f => Model f -> Rule f -> Subst f -> Bool+reducesInModel cond rule sub =+  reducesWith (\t u -> isJust (lessIn cond t u)) rule sub++-- | Check if a rule can be applied to the Skolemised version of a term.+{-# INLINEABLE reducesSkolem #-}+reducesSkolem :: Function f => Rule f -> Subst f -> Bool+reducesSkolem rule sub =+  reducesWith (\t u -> lessEq (subst skolemise t) (subst skolemise u)) rule sub+  where+    skolemise = con . skolem
+ Twee/Rule/Index.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, FlexibleContexts #-}+module Twee.Rule.Index(+  RuleIndex(..),+  empty, insert, delete,+  approxMatches, matches, lookup) where++import Prelude hiding (lookup)+import Twee.Base hiding (lookup, empty)+import Twee.Rule+import Twee.Index hiding (insert, delete, empty)+import qualified Twee.Index as Index++data RuleIndex f a =+  RuleIndex {+    index_oriented :: !(Index f a),+    index_weak     :: !(Index f a),+    index_all      :: !(Index f a) }+  deriving Show++empty :: RuleIndex f a+empty = RuleIndex Index.empty Index.empty Index.empty++insert :: forall f a. Has a (Rule f) => Term f -> a -> RuleIndex f a -> RuleIndex f a+insert t x RuleIndex{..} =+  RuleIndex {+    index_oriented = insertWhen (oriented or) index_oriented,+    index_weak = insertWhen (weaklyOriented or) index_weak,+    index_all = insertWhen True index_all }+  where+    Rule or _ _ = the x :: Rule f++    insertWhen False idx = idx+    insertWhen True idx = Index.insert t x idx++delete :: forall f a. (Eq a, Has a (Rule f)) => Term f -> a -> RuleIndex f a -> RuleIndex f a+delete t x RuleIndex{..} =+  RuleIndex {+    index_oriented = deleteWhen (oriented or) index_oriented,+    index_weak = deleteWhen (weaklyOriented or) index_weak,+    index_all = deleteWhen True index_all }+  where+    Rule or _ _ = the x :: Rule f++    deleteWhen False idx = idx+    deleteWhen True idx = Index.delete t x idx
+ Twee/Task.hs view
@@ -0,0 +1,56 @@+-- | A module which can run housekeeping tasks every so often.+{-# LANGUAGE RecordWildCards #-}+module Twee.Task(Task, newTask, checkTask) where++import System.CPUTime+import Data.IORef+import Control.Monad.IO.Class++data TaskData m a =+  TaskData {+    -- When was the task created?+    task_start :: !Integer,+    -- When was the task last run?+    task_last :: !Integer,+    -- How long have we spent on this task so far?+    task_spent :: !Integer,+    -- How often should we run this task at most, in seconds?+    task_frequency :: !Double,+    -- What proportion of our time should we spend on the task?+    task_budget :: !Double,+    -- The task itself+    task_what :: m a }++-- | A task which runs in the monad @m@ and produces a value of type @a@.+newtype Task m a = Task (IORef (TaskData m a))++-- | Create a new task that should be run a certain proportion+-- of the time. The first argument is how often in seconds the+-- task should run, at most. The second argument is the maximum+-- percentage of time that should be spent on the task.+newTask :: MonadIO m => Double -> Double -> m a -> m (Task m a)+newTask freq budget what = liftIO $ do+  now <- getCPUTime+  Task <$> newIORef (TaskData now now 0 freq budget what)++-- | Run a task if it's time to run it.+checkTask :: MonadIO m => Task m a -> m (Maybe a)+checkTask (Task ref) = do+  task@TaskData{..} <- liftIO $ readIORef ref+  now <- liftIO getCPUTime+  if not (taskDue now task) then return Nothing else do+    res <- task_what+    after <- liftIO getCPUTime+    liftIO $ writeIORef ref task {+      task_last = after,+      task_spent = task_spent + (after-now) }+    return (Just res)++-- Check if a task should be run now.+taskDue :: Integer -> TaskData m a -> Bool+taskDue now TaskData{..} =+  -- Don't run more than the frequency says.+  fromInteger (now - task_last) >= task_frequency * 10^12 &&+  -- Run if we spent less than task_budget proportion of the total time so far.+  -- Use > rather than >= so that tasks with zero budget never get run.+  fromInteger (now - task_start) * task_budget > fromInteger task_spent
+ Twee/Term.hs view
@@ -0,0 +1,647 @@+-- | Terms and substitutions.+--+-- Terms in twee are represented as arrays rather than as an algebraic data+-- type. This module defines pattern synonyms ('App', 'Var', 'Cons', 'Empty')+-- which means that pattern matching on terms works just as normal.+-- The pattern synonyms can not be used to create new terms; for that you+-- have to use a builder interface ('Build').+--+-- This module also provides:+--+--   * pattern synonyms for iterating through a term one symbol at a time+--     ('ConsSym');+--   * substitutions ('Substitution', 'Subst', 'subst');+--   * unification ('unify') and matching ('match');+--   * miscellaneous useful functions on terms.+{-# LANGUAGE BangPatterns, PatternSynonyms, ViewPatterns, TypeFamilies, OverloadedStrings, ScopedTypeVariables #-}+module Twee.Term(+  -- * Terms+  Term, pattern Var, pattern App, isApp, isVar, singleton, len,+  -- * Termlists+  TermList, pattern Empty, pattern Cons, pattern ConsSym,+  pattern UnsafeCons, pattern UnsafeConsSym,+  empty, unpack, lenList,+  -- * Function symbols and variables+  Fun, fun, fun_id, fun_value, pattern F, Var(..), +  -- * Building terms+  Build(..),+  Builder,+  build, buildList,+  con, app, var,+  -- * Access to subterms+  children, properSubterms, subtermsList, subterms, occurs, isSubtermOf, isSubtermOfList, at,+  -- * Substitutions+  Substitution(..),+  subst,+  Subst(..),+  -- ** Constructing and querying substitutions+  emptySubst, listToSubst, substToList,+  lookup, lookupList,+  extend, extendList, unsafeExtendList,+  retract,+  -- ** Other operations on substitutions+  foldSubst, allSubst, substDomain,+  substSize,+  substCompose, substCompatible, substUnion, idempotent, idempotentOn,+  canonicalise,+  -- * Matching+  match, matchIn, matchList, matchListIn, isInstanceOf, isVariantOf,+  -- * Unification+  unify, unifyList,+  unifyTri, unifyListTri,+  TriangleSubst(..),+  close,+  -- * Positions in terms+  positionToPath, pathToPosition,+  replacePosition,+  replacePositionSub,+  -- * Miscellaneous functions+  bound, boundList, boundLists, mapFun, mapFunList, (<<)) where++import Prelude hiding (lookup)+import Twee.Term.Core hiding (F)+import Data.List hiding (lookup, find)+import Data.Maybe+import Data.Monoid+import Data.IntMap.Strict(IntMap)+import qualified Data.IntMap.Strict as IntMap++--------------------------------------------------------------------------------+-- * A type class for builders+--------------------------------------------------------------------------------++-- | Instances of 'Build' can be turned into terms using 'build' or 'buildList',+-- and turned into term builders using 'builder'. Has instances for terms,+-- termlists, builders, and Haskell lists.+class Build a where+  -- | The underlying type of function symbols.+  type BuildFun a+  -- | Convert a value into a 'Builder'.+  builder :: a -> Builder (BuildFun a)++instance Build (Builder f) where+  type BuildFun (Builder f) = f+  builder = id++instance Build (Term f) where+  type BuildFun (Term f) = f+  builder = emitTermList . singleton++instance Build (TermList f) where+  type BuildFun (TermList f) = f+  builder = emitTermList++instance Build a => Build [a] where+  type BuildFun [a] = BuildFun a+  {-# INLINE builder #-}+  builder = mconcat . map builder++-- | Build a term. The given builder must produce exactly one term.+{-# INLINE build #-}+build :: Build a => a -> Term (BuildFun a)+build x =+  case buildList x of+    Cons t Empty -> t++-- | Build a termlist.+{-# INLINE buildList #-}+buildList :: Build a => a -> TermList (BuildFun a)+buildList x = {-# SCC buildList #-} buildTermList (builder x)++-- | Build a constant (a function with no arguments).+{-# INLINE con #-}+con :: Fun f -> Builder f+con x = emitApp x mempty++-- | Build a function application.+{-# INLINE app #-}+app :: Build a => Fun (BuildFun a) -> a -> Builder (BuildFun a)+app f ts = emitApp f (builder ts)++-- | Build a variable.+var :: Var -> Builder f+var = emitVar++--------------------------------------------------------------------------------+-- Functions for substitutions.+--------------------------------------------------------------------------------++{-# INLINE substToList' #-}+substToList' :: Subst f -> [(Var, TermList f)]+substToList' (Subst sub) = [(V x, t) | (x, t) <- IntMap.toList sub]++-- | Convert a substitution to a list of bindings.+{-# INLINE substToList #-}+substToList :: Subst f -> [(Var, Term f)]+substToList sub =+  [(x, t) | (x, Cons t Empty) <- substToList' sub]++-- | Fold a function over a substitution.+{-# INLINE foldSubst #-}+foldSubst :: (Var -> TermList f -> b -> b) -> b -> Subst f -> b+foldSubst op e !sub = foldr (uncurry op) e (substToList' sub)++-- | Check if all bindings of a substitution satisfy a given property.+{-# INLINE allSubst #-}+allSubst :: (Var -> TermList f -> Bool) -> Subst f -> Bool+allSubst p = foldSubst (\x t y -> p x t && y) True++-- | Compute the set of variables bound by a substitution.+{-# INLINE substDomain #-}+substDomain :: Subst f -> [Var]+substDomain (Subst sub) = map V (IntMap.keys sub)++--------------------------------------------------------------------------------+-- Substitution.+--------------------------------------------------------------------------------++-- | A class for values which act as substitutions.+--+-- Instances include 'Subst' as well as functions from variables to terms.+class Substitution s where+  -- | The underlying type of function symbols.+  type SubstFun s++  -- | Apply the substitution to a variable.+  evalSubst :: s -> Var -> Builder (SubstFun s)++  -- | Apply the substitution to a termlist.+  {-# INLINE substList #-}+  substList :: s -> TermList (SubstFun s) -> Builder (SubstFun s)+  substList sub ts = aux ts+    where+      aux Empty = mempty+      aux (Cons (Var x) ts) = evalSubst sub x <> aux ts+      aux (Cons (App f ts) us) = app f (aux ts) <> aux us++instance (Build a, v ~ Var) => Substitution (v -> a) where+  type SubstFun (v -> a) = BuildFun a++  {-# INLINE evalSubst #-}+  evalSubst sub x = builder (sub x)++instance Substitution (Subst f) where+  type SubstFun (Subst f) = f++  {-# INLINE evalSubst #-}+  evalSubst sub x =+    case lookupList x sub of+      Nothing -> var x+      Just ts -> builder ts++-- | Apply a substitution to a term.+{-# INLINE subst #-}+subst :: Substitution s => s -> Term (SubstFun s) -> Builder (SubstFun s)+subst sub t = substList sub (singleton t)++-- | A substitution which maps variables to terms of type @'Term' f@.+newtype Subst f =+  Subst {+    unSubst :: IntMap (TermList f) }+  deriving Eq++-- | Return the highest-number variable in a substitution plus 1.+{-# INLINE substSize #-}+substSize :: Subst f -> Int+substSize (Subst sub)+  | IntMap.null sub = 0+  | otherwise = fst (IntMap.findMax sub) + 1++-- | Look up a variable in a substitution, returning a termlist.+{-# INLINE lookupList #-}+lookupList :: Var -> Subst f -> Maybe (TermList f)+lookupList x (Subst sub) = IntMap.lookup (var_id x) sub++-- | Add a new binding to a substitution, giving a termlist.+{-# INLINE extendList #-}+extendList :: Var -> TermList f -> Subst f -> Maybe (Subst f)+extendList x !t (Subst sub) =+  case IntMap.lookup (var_id x) sub of+    Nothing -> Just $! Subst (IntMap.insert (var_id x) t sub)+    Just u+      | t == u    -> Just (Subst sub)+      | otherwise -> Nothing++-- | Remove a binding from a substitution.+{-# INLINE retract #-}+retract :: Var -> Subst f -> Subst f+retract x (Subst sub) = Subst (IntMap.delete (var_id x) sub)++-- | Add a new binding to a substitution.+-- Overwrites any existing binding.+{-# INLINE unsafeExtendList #-}+unsafeExtendList :: Var -> TermList f -> Subst f -> Subst f+unsafeExtendList x !t (Subst sub) = Subst (IntMap.insert (var_id x) t sub)++-- | Compose two substitutions.+substCompose :: Substitution s => Subst (SubstFun s) -> s -> Subst (SubstFun s)+substCompose (Subst !sub1) !sub2 =+  Subst (IntMap.map (buildList . substList sub2) sub1)++-- | Check if two substitutions are compatible (they do not send the same+-- variable to different terms).+substCompatible :: Subst f -> Subst f -> Bool+substCompatible (Subst !sub1) (Subst !sub2) =+  IntMap.null (IntMap.mergeWithKey f g h sub1 sub2)+  where+    f _ t u+      | t == u = Nothing+      | otherwise = Just t+    g _ = IntMap.empty+    h _ = IntMap.empty++-- | Take the union of two substitutions.+-- The substitutions must be compatible, which is not checked.+substUnion :: Subst f -> Subst f -> Subst f+substUnion (Subst !sub1) (Subst !sub2) =+  Subst (IntMap.union sub1 sub2)++-- | Check if a substitution is idempotent (applying it twice has the same+-- effect as applying it once).+{-# INLINE idempotent #-}+idempotent :: Subst f -> Bool+idempotent !sub = allSubst (\_ t -> sub `idempotentOn` t) sub++-- | Check if a substitution has no effect on a given term.+{-# INLINE idempotentOn #-}+idempotentOn :: Subst f -> TermList f -> Bool+idempotentOn !sub = aux+  where+    aux Empty = True+    aux (ConsSym App{} t) = aux t+    aux (Cons (Var x) t) = isNothing (lookupList x sub) && aux t++-- | Iterate a triangle substitution to make it idempotent.+close :: TriangleSubst f -> Subst f+close (Triangle sub)+  | idempotent sub = sub+  | otherwise      = close (Triangle (substCompose sub sub))++-- | Return a substitution which renames the variables of a list of terms to put+-- them in a canonical order.+canonicalise :: [TermList f] -> Subst f+canonicalise [] = emptySubst+canonicalise (t:ts) = loop emptySubst vars t ts+  where+    (V m, V n) = boundLists (t:ts)+    vars =+      buildTermList $+        -- Produces two variables when the term is ground+        -- (n = minBound, m = maxBound), which is OK.+        mconcat [emitVar (V x) | x <- [0..n-m+1]]++    loop !_ !_ !_ !_ | False = undefined+    loop sub _ Empty [] = sub+    loop sub Empty _ _ = sub+    loop sub vs Empty (t:ts) = loop sub vs t ts+    loop sub vs (ConsSym App{} t) ts = loop sub vs t ts+    loop sub vs0@(Cons v vs) (Cons (Var x) t) ts =+      case extend x v sub of+        Just sub -> loop sub vs  t ts+        Nothing  -> loop sub vs0 t ts++-- | The empty substitution.+{-# NOINLINE emptySubst #-}+emptySubst = Subst IntMap.empty++-- | Construct a substitution from a list.+-- Returns @Nothing@ if a variable is bound to several different terms.+listToSubst :: [(Var, Term f)] -> Maybe (Subst f)+listToSubst sub = matchList pat t+  where+    pat = buildList (map (var . fst) sub)+    t   = buildList (map snd sub)++--------------------------------------------------------------------------------+-- Matching.+--------------------------------------------------------------------------------++-- | @'match' pat t@ matches the term @t@ against the pattern @pat@.+{-# INLINE match #-}+match :: Term f -> Term f -> Maybe (Subst f)+match pat t = matchList (singleton pat) (singleton t)++-- | A variant of 'match' which extends an existing substitution.+{-# INLINE matchIn #-}+matchIn :: Subst f -> Term f -> Term f -> Maybe (Subst f)+matchIn sub pat t = matchListIn sub (singleton pat) (singleton t)++-- | A variant of 'match' which works on termlists.+{-# INLINE matchList #-}+matchList :: TermList f -> TermList f -> Maybe (Subst f)+matchList pat t = matchListIn emptySubst pat t++-- | A variant of 'match' which works on termlists+-- and extends an existing substitution.+matchListIn :: Subst f -> TermList f -> TermList f -> Maybe (Subst f)+matchListIn !sub !pat !t+  | lenList t < lenList pat = Nothing+  | otherwise =+    let loop !_ !_ !_ | False = undefined+        loop sub Empty Empty = Just sub+        loop sub (ConsSym (App f _) pat) (ConsSym (App g _) t)+          | f == g = loop sub pat t+        loop sub (Cons (Var x) pat) (Cons t u) = do+          sub <- extend x t sub+          loop sub pat u+        loop _ _ _ = Nothing+    in {-# SCC match #-} loop sub pat t++--------------------------------------------------------------------------------+-- Unification.+--------------------------------------------------------------------------------++-- | A triangle substitution is one in which variables can be defined in terms+-- of each other, though not in a circular way.+--+-- The main use of triangle substitutions is in unification; 'unifyTri' returns+-- one. A triangle substitution can be converted to an ordinary substitution+-- with 'close', or used directly using its 'Substitution' instance.+newtype TriangleSubst f = Triangle { unTriangle :: Subst f }+  deriving Show++instance Substitution (TriangleSubst f) where+  type SubstFun (TriangleSubst f) = f++  {-# INLINE evalSubst #-}+  evalSubst (Triangle sub) x =+    case lookupList x sub of+      Nothing  -> var x+      Just ts  -> substList (Triangle sub) ts++  -- Redefine substList to get better inlining behaviour+  {-# INLINE substList #-}+  substList (Triangle sub) ts = aux ts+    where+      aux Empty = mempty+      aux (Cons (Var x) ts) = auxVar x <> aux ts+      aux (Cons (App f ts) us) = app f (aux ts) <> aux us++      auxVar x =+        case lookupList x sub of+          Nothing -> var x+          Just ts -> aux ts++-- | Unify two terms.+unify :: Term f -> Term f -> Maybe (Subst f)+unify t u = unifyList (singleton t) (singleton u)++-- | Unify two termlists.+unifyList :: TermList f -> TermList f -> Maybe (Subst f)+unifyList t u = do+  sub <- unifyListTri t u+  -- Not strict so that isJust (unify t u) doesn't force the substitution+  return (close sub)++-- | Unify two terms, returning a triangle substitution.+-- This is slightly faster than 'unify'.+unifyTri :: Term f -> Term f -> Maybe (TriangleSubst f)+unifyTri t u = unifyListTri (singleton t) (singleton u)++-- | Unify two termlists, returning a triangle substitution.+-- This is slightly faster than 'unify'.+unifyListTri :: TermList f -> TermList f -> Maybe (TriangleSubst f)+unifyListTri !t !u = fmap Triangle ({-# SCC unify #-} loop emptySubst t u)+  where+    loop !_ !_ !_ | False = undefined+    loop sub Empty Empty = Just sub+    loop sub (ConsSym (App f _) t) (ConsSym (App g _) u)+      | f == g = loop sub t u+    loop sub (Cons (Var x) t) (Cons u v) = do+      sub <- var sub x u+      loop sub t v+    loop sub (Cons t u) (Cons (Var x) v) = do+      sub <- var sub x t+      loop sub u v+    loop _ _ _ = Nothing++    var sub x t =+      case lookupList x sub of+        Just u -> loop sub u (singleton t)+        Nothing -> var1 sub x t++    var1 sub x t@(Var y)+      | x == y = return sub+      | otherwise =+        case lookup y sub of+          Just t  -> var1 sub x t+          Nothing -> extend x t sub++    var1 sub x t = do+      occurs sub x (singleton t)+      extend x t sub++    occurs !_ !_ Empty = Just ()+    occurs sub x (ConsSym App{} t) = occurs sub x t+    occurs sub x (ConsSym (Var y) t)+      | x == y = Nothing+      | otherwise = do+          occurs sub x t+          case lookupList y sub of+            Nothing -> Just ()+            Just u  -> occurs sub x u++--------------------------------------------------------------------------------+-- Miscellaneous stuff.+--------------------------------------------------------------------------------++-- | The empty termlist.+{-# NOINLINE empty #-}+empty :: forall f. TermList f+empty = buildList (mempty :: Builder f)++-- | Get the children (direct subterms) of a term.+children :: Term f -> TermList f+children t =+  case singleton t of+    UnsafeConsSym _ ts -> ts++-- | Convert a termlist into an ordinary list of terms.+unpack :: TermList f -> [Term f]+unpack t = unfoldr op t+  where+    op Empty = Nothing+    op (Cons t ts) = Just (t, ts)++instance Show (Term f) where+  show (Var x) = show x+  show (App f Empty) = show f+  show (App f ts) = show f ++ "(" ++ intercalate "," (map show (unpack ts)) ++ ")"++instance Show (TermList f) where+  show = show . unpack++instance Show (Subst f) where+  show subst =+    show+      [ (i, t)+      | i <- [0..substSize subst-1],+        Just t <- [lookup (V i) subst] ]++-- | Look up a variable in a substitution.+{-# INLINE lookup #-}+lookup :: Var -> Subst f -> Maybe (Term f)+lookup x s = do+  Cons t Empty <- lookupList x s+  return t++-- | Add a new binding to a substitution.+{-# INLINE extend #-}+extend :: Var -> Term f -> Subst f -> Maybe (Subst f)+extend x t sub = extendList x (singleton t) sub++-- | Find the length of a term.+{-# INLINE len #-}+len :: Term f -> Int+len = lenList . singleton++-- | Return the lowest- and highest-numbered variables in a term.+{-# INLINE bound #-}+bound :: Term f -> (Var, Var)+bound t = boundList (singleton t)++-- | Return the lowest- and highest-numbered variables in a termlist.+{-# INLINE boundList #-}+boundList :: TermList f -> (Var, Var)+boundList t = boundListFrom (V maxBound) (V minBound) t++boundListFrom :: Var -> Var -> TermList f -> (Var, Var)+boundListFrom !m !n Empty = (m, n)+boundListFrom m n (ConsSym App{} t) = boundListFrom m n t+boundListFrom m n (ConsSym (Var x) t) =+  boundListFrom (m `min` x) (n `max` x) t++-- | Return the lowest- and highest-numbered variables in a list of termlists.+boundLists :: [TermList f] -> (Var, Var)+boundLists t = boundListsFrom (V maxBound) (V minBound) t++boundListsFrom :: Var -> Var -> [TermList f] -> (Var, Var)+boundListsFrom !m !n [] = (m, n)+boundListsFrom m n (t:ts) =+  let+    (m', n') = boundListFrom m n t+  in+    boundListsFrom m' n' ts++-- | Check if a variable occurs in a term.+{-# INLINE occurs #-}+occurs :: Var -> Term f -> Bool+occurs x t = occursList x (singleton t)++-- | Find all subterms of a termlist.+{-# INLINE subtermsList #-}+subtermsList :: TermList f -> [Term f]+subtermsList t = unfoldr op t+  where+    op Empty = Nothing+    op (ConsSym t u) = Just (t, u)++-- | Find all subterms of a term.+{-# INLINE subterms #-}+subterms :: Term f -> [Term f]+subterms = subtermsList . singleton++-- | Find all proper subterms of a term.+{-# INLINE properSubterms #-}+properSubterms :: Term f -> [Term f]+properSubterms = subtermsList . children++-- | Check if a term is a function application.+isApp :: Term f -> Bool+isApp App{} = True+isApp _     = False++-- | Check if a term is a variable+isVar :: Term f -> Bool+isVar Var{} = True+isVar _     = False++-- | @t \`'isInstanceOf'\` pat@ checks if @t@ is an instance of @pat@.+isInstanceOf :: Term f -> Term f -> Bool+t `isInstanceOf` pat = isJust (match pat t)++-- | Check if two terms are renamings of one another.+isVariantOf :: Term f -> Term f -> Bool+t `isVariantOf` u = t `isInstanceOf` u && u `isInstanceOf` t++-- | Is a term a subterm of another one?+isSubtermOf :: Term f -> Term f -> Bool+t `isSubtermOf` u = t `isSubtermOfList` singleton u++-- | Map a function over the function symbols in a term.+mapFun :: (Fun f -> Fun g) -> Term f -> Builder g+mapFun f = mapFunList f . singleton++-- | Map a function over the function symbols in a termlist.+mapFunList :: (Fun f -> Fun g) -> TermList f -> Builder g+mapFunList f ts = aux ts+  where+    aux Empty = mempty+    aux (Cons (Var x) ts) = var x `mappend` aux ts+    aux (Cons (App ff ts) us) = app (f ff) (aux ts) `mappend` aux us++-- | Replace the term at a given position in a term with a different term.+{-# INLINE replacePosition #-}+replacePosition :: (Build a, BuildFun a ~ f) => Int -> a -> TermList f -> Builder f+replacePosition n !x = aux n+  where+    aux !_ !_ | False = undefined+    aux _ Empty = mempty+    aux 0 (Cons _ t) = builder x `mappend` builder t+    aux n (Cons (Var x) t) = var x `mappend` aux (n-1) t+    aux n (Cons t@(App f ts) u)+      | n < len t =+        app f (aux (n-1) ts) `mappend` builder u+      | otherwise =+        builder t `mappend` aux (n-len t) u++-- | Replace the term at a given position in a term with a different term, while+-- simultaneously applying a substitution. Useful for building critical pairs.+{-# INLINE replacePositionSub #-}+replacePositionSub :: (Substitution sub, SubstFun sub ~ f) => sub -> Int -> TermList f -> TermList f -> Builder f+replacePositionSub sub n !x = aux n+  where+    aux !_ !_ | False = undefined+    aux _ Empty = mempty+    aux n (Cons t u)+      | n < len t = inside n t `mappend` outside u+      | otherwise = outside (singleton t) `mappend` aux (n-len t) u++    inside 0 _ = outside x+    inside n (App f ts) = app f (aux (n-1) ts)+    inside _ _ = undefined -- implies n >= len t++    outside t = substList sub t++-- | Convert a position in a term, expressed as a single number, into a path.+positionToPath :: Term f -> Int -> [Int]+positionToPath t n = term t n+  where+    term _ 0 = []+    term t n = list 0 (children t) (n-1)++    list _ Empty _ = error "bad position"+    list k (Cons t u) n+      | n < len t = k:term t n+      | otherwise = list (k+1) u (n-len t)++-- | Convert a path in a term into a position.+pathToPosition :: Term f -> [Int] -> Int+pathToPosition t ns = term 0 t ns+  where+    term k _ [] = k+    term k t (n:ns) = list (k+1) (children t) n ns++    list _ Empty _ _ = error "bad path"+    list k (Cons t _) 0 ns = term k t ns+    list k (Cons t u) n ns =+      list (k+len t) u (n-1) ns++-- | A pattern which extracts the 'fun_value' from a 'Fun'.+pattern F :: f -> Fun f+pattern F x <- (fun_value -> x)+{-# COMPLETE F #-}++-- | Compare the 'fun_value's of two 'Fun's.+(<<) :: Ord f => Fun f -> Fun f -> Bool+f << g = fun_value f < fun_value g
+ Twee/Term/Core.hs view
@@ -0,0 +1,427 @@+-- Terms and substitutions, implemented using flatterms.+-- This module contains all the low-level icky bits+-- and provides primitives for building higher-level stuff.+{-# LANGUAGE CPP, PatternSynonyms, ViewPatterns,+    MagicHash, UnboxedTuples, BangPatterns,+    RankNTypes, RecordWildCards, GeneralizedNewtypeDeriving #-}+module Twee.Term.Core where++import Data.Primitive(sizeOf)+#ifdef BOUNDS_CHECKS+import Data.Primitive.ByteArray.Checked+#else+import Data.Primitive.ByteArray+#endif+import Control.Monad.ST.Strict+import Data.Bits+import Data.Int+import GHC.Int(Int(..))+import GHC.Prim+import GHC.ST hiding (liftST)+import Data.Ord+import Twee.Label+import Data.Typeable++--------------------------------------------------------------------------------+-- Symbols. A symbol is a single function or variable in a flatterm.+--------------------------------------------------------------------------------++data Symbol =+  Symbol {+    -- Is it a function?+    isFun :: Bool,+    -- What is its number?+    index :: Int,+    -- What is the size of the term rooted at this symbol?+    size  :: Int }++instance Show Symbol where+  show Symbol{..}+    | isFun = show (F index) ++ "=" ++ show size+    | otherwise = show (V index)++-- Convert symbols to/from Int64 for storage in flatterms.+-- The encoding:+--   * bits 0-30: size+--   * bit  31: 0 (variable) or 1 (function)+--   * bits 32-63: index+{-# INLINE toSymbol #-}+toSymbol :: Int64 -> Symbol+toSymbol n =+  Symbol (testBit n 31)+    (fromIntegral (n `unsafeShiftR` 32))+    (fromIntegral (n .&. 0x7fffffff))++{-# INLINE fromSymbol #-}+fromSymbol :: Symbol -> Int64+fromSymbol Symbol{..} =+  fromIntegral size ++  fromIntegral index `unsafeShiftL` 32 ++  fromIntegral (fromEnum isFun) `unsafeShiftL` 31++--------------------------------------------------------------------------------+-- Flatterms, or rather lists of terms.+--------------------------------------------------------------------------------++-- | @'TermList' f@ is a list of terms whose function symbols have type @f@.+-- It is either a 'Cons' or an 'Empty'. You can turn it into a @['Term' f]@+-- with 'Twee.Term.unpack'.++-- A TermList is a slice of an unboxed array of symbols.+data TermList f =+  TermList {+    low   :: {-# UNPACK #-} !Int,+    high  :: {-# UNPACK #-} !Int,+    array :: {-# UNPACK #-} !ByteArray }++-- | Index into a termlist.+at :: Int -> TermList f -> Term f+at n (TermList lo hi arr)+  | n < 0 || lo+n >= hi = error "term index out of bounds"+  | otherwise =+    case TermList (lo+n) hi arr of+      UnsafeCons t _ -> t++{-# INLINE lenList #-}+-- | The length of (number of symbols in) a termlist.+lenList :: TermList f -> Int+lenList (TermList low high _) = high - low++-- | @'Term' f@ is a term whose function symbols have type @f@.+-- It is either a 'Var' or an 'App'.++-- A term is a special case of a termlist.+-- We store it as the termlist together with the root symbol.+data Term f =+  Term {+    root     :: {-# UNPACK #-} !Int64,+    termlist :: {-# UNPACK #-} !(TermList f) }++instance Eq (Term f) where+  x == y = termlist x == termlist y++instance Ord (Term f) where+  compare = comparing termlist++-- Pattern synonyms for termlists:+-- * Empty :: TermList f+--   Empty is the empty termlist.+-- * Cons t ts :: Term f -> TermList f -> TermList f+--   Cons t ts is the termlist t:ts.+-- * ConsSym t ts :: Term f -> TermList f -> TermList f+--   ConsSym t ts is like Cons t ts but ts also includes t's children+--   (operationally, ts seeks one term to the right in the termlist).+-- * UnsafeCons/UnsafeConsSym: like Cons and ConsSym but don't check+--   that the termlist is non-empty.++-- | Matches the empty termlist.+pattern Empty :: TermList f+pattern Empty <- (patHead -> Nothing)++-- | Matches a non-empty termlist, unpacking it into head and tail.+pattern Cons :: Term f -> TermList f -> TermList f+pattern Cons t ts <- (patHead -> Just (t, _, ts))++{-# COMPLETE Empty, Cons #-}+{-# COMPLETE Empty, ConsSym #-}++-- | Like 'Cons', but does not check that the termlist is non-empty. Use only if+-- you are sure the termlist is non-empty.+pattern UnsafeCons :: Term f -> TermList f -> TermList f+pattern UnsafeCons t ts <- (unsafePatHead -> Just (t, _, ts))++-- | Matches a non-empty termlist, unpacking it into head and+-- /everything except the root symbol of the head/.+-- Useful for iterating through terms one symbol at a time.+--+-- For example, if @ts@ is the termlist @[f(x,y), g(z)]@,+-- then @let ConsSym u us = ts@ results in the following bindings:+--+-- > u  = f(x,y)+-- > us = [x, y, g(z)]+pattern ConsSym :: Term f -> TermList f -> TermList f+pattern ConsSym t ts <- (patHead -> Just (t, ts, _))++-- | Like 'ConsSym', but does not check that the termlist is non-empty. Use only+-- if you are sure the termlist is non-empty.+pattern UnsafeConsSym :: Term f -> TermList f -> TermList f+pattern UnsafeConsSym t ts <- (unsafePatHead -> Just (t, ts, _))++-- A helper for UnsafeCons/UnsafeConsSym.+{-# INLINE unsafePatHead #-}+unsafePatHead :: TermList f -> Maybe (Term f, TermList f, TermList f)+unsafePatHead TermList{..} =+  Just (Term x (TermList low (low+size) array),+        TermList (low+1) high array,+        TermList (low+size) high array)+  where+    !x = indexByteArray array low+    Symbol{..} = toSymbol x++-- A helper for Cons/ConsSym.+{-# INLINE patHead #-}+patHead :: TermList f -> Maybe (Term f, TermList f, TermList f)+patHead t@TermList{..}+  | low == high = Nothing+  | otherwise = unsafePatHead t++-- Pattern synonyms for single terms.+-- * Var :: Var -> Term f+-- * App :: Fun f -> TermList f -> Term f++-- | A function symbol. @f@ is the underlying type of function symbols defined+-- by the user; @'Fun' f@ is an @f@ together with an automatically-generated unique number.+newtype Fun f =+  F {+    -- | The unique number of a 'Fun'.+    fun_id :: Int }+instance Eq (Fun f) where+  f == g = fun_id f == fun_id g+instance Ord (Fun f) where+  compare = comparing fun_id++-- | Construct a 'Fun' from a function symbol.+fun :: (Ord f, Typeable f) => f -> Fun f+fun f = F (fromIntegral (labelNum (label f)))++-- | The underlying function symbol of a 'Fun'.+fun_value :: Fun f -> f+fun_value f = find (unsafeMkLabel (fromIntegral (fun_id f)))++-- | A variable.+newtype Var =+  V {+    -- | The variable's number.+    -- Don't use huge variable numbers:+    -- they will be truncated to 32 bits when stored in a term.+    var_id :: Int } deriving (Eq, Ord, Enum)+instance Show (Fun f) where show f = "f" ++ show (fun_id f)+instance Show Var     where show x = "x" ++ show (var_id x)++-- | Matches a variable.+pattern Var :: Var -> Term f+pattern Var x <- (patTerm -> Left x)++-- | Matches a function application.+pattern App :: Fun f -> TermList f -> Term f+pattern App f ts <- (patTerm -> Right (f, ts))++{-# COMPLETE Var, App #-}++-- A helper function for Var and App.+{-# INLINE patTerm #-}+patTerm :: Term f -> Either Var (Fun f, TermList f)+patTerm t@Term{..}+  | isFun     = Right (F index, ts)+  | otherwise = Left (V index)+  where+    Symbol{..} = toSymbol root+    !(UnsafeConsSym _ ts) = singleton t++-- | Convert a term to a termlist.+{-# INLINE singleton #-}+singleton :: Term f -> TermList f+singleton Term{..} = termlist++-- We can implement equality almost without access to the+-- internal representation of the termlists, but we cheat by+-- comparing Int64s instead of Symbols.+instance Eq (TermList f) where+  -- Manual worker-wrapper to prevent too much from being inlined.+  t == u = eqTermList t u++{-# INLINE eqTermList #-}+eqTermList :: TermList f -> TermList f -> Bool+eqTermList+  (TermList (I# low1) (I# high1) (ByteArray array1))+  (TermList (I# low2) (I# high2) (ByteArray array2)) =+    weqTermList low1 high1 array1 low2 high2 array2++-- Manually worker-wrapper transform the thing, ugh...+{-# NOINLINE weqTermList #-}+weqTermList ::+  Int# -> Int# -> ByteArray# ->+  Int# -> Int# -> ByteArray# ->+  Bool+weqTermList low1 high1 array1 low2 high2 array2 =+  lenList t == lenList u && eqSameLength t u+  where+    t = TermList (I# low1) (I# high1) (ByteArray array1)+    u = TermList (I# low2) (I# high2) (ByteArray array2)+    eqSameLength Empty !_ = True+    eqSameLength (ConsSym s1 t) (UnsafeConsSym s2 u) =+      root s1 == root s2 && eqSameLength t u++instance Ord (TermList f) where+  {-# INLINE compare #-}+  compare t u =+    case compare (lenList t) (lenList u) of+      EQ -> compareContents t u+      x  -> x++compareContents :: TermList f -> TermList f -> Ordering+compareContents Empty !_ = EQ+compareContents (ConsSym s1 t) (UnsafeConsSym s2 u) =+  case compare (root s1) (root s2) of+    EQ -> compareContents t u+    x  -> x++--------------------------------------------------------------------------------+-- Building terms.+--------------------------------------------------------------------------------++-- | A monoid for building terms.+-- 'mempty' represents the empty termlist, while 'mappend' appends two termlists.+newtype Builder f =+  Builder {+    unBuilder ::+      -- Takes: the term array and size, and current position in the term.+      -- Returns the final position, which may be out of bounds.+      forall s. Builder1 s f }++type Builder1 s f = State# s -> MutableByteArray# s -> Int# -> Int# -> (# State# s, Int# #)++instance Monoid (Builder f) where+  {-# INLINE mempty #-}+  mempty = Builder built+  {-# INLINE mappend #-}+  Builder m1 `mappend` Builder m2 = Builder (m1 `then_` m2)++-- Build a termlist from a Builder.+-- Works by guessing an appropriate size, and retrying if that was too small.+{-# INLINE buildTermList #-}+buildTermList :: Builder f -> TermList f+buildTermList builder = runST $ do+  let+    Builder m = builder+    loop n@(I# n#) = do+      MutableByteArray mbytearray# <-+        newByteArray (n * sizeOf (fromSymbol undefined))+      n' <-+        ST $ \s ->+          case m s mbytearray# n# 0# of+            (# s, n# #) -> (# s, I# n# #)+      if n' <= n then do+        !bytearray <- unsafeFreezeByteArray (MutableByteArray mbytearray#)+        return (TermList 0 n' bytearray)+       else loop (n'*2)+  loop 32++-- Get at the term array.+{-# INLINE getByteArray #-}+getByteArray :: (MutableByteArray s -> Builder1 s f) -> Builder1 s f+getByteArray k = \s bytearray n i -> k (MutableByteArray bytearray) s bytearray n i++-- Get at the array size.+{-# INLINE getSize #-}+getSize :: (Int -> Builder1 s f) -> Builder1 s f+getSize k = \s bytearray n i -> k (I# n) s bytearray n i++-- Get at the current array index.+{-# INLINE getIndex #-}+getIndex :: (Int -> Builder1 s f) -> Builder1 s f+getIndex k = \s bytearray n i -> k (I# i) s bytearray n i++-- Change the current array index.+{-# INLINE putIndex #-}+putIndex :: Int -> Builder1 s f+putIndex (I# i) = \s _ _ _ -> (# s, i #)++-- Lift an ST computation into a builder.+{-# INLINE liftST #-}+liftST :: ST s () -> Builder1 s f+liftST (ST m) =+  \s _ _ i ->+  case m s of+    (# s, () #) -> (# s, i #)++-- Finish building.+{-# INLINE built #-}+built :: Builder1 s f+built = \s _ _ i -> (# s, i #)++-- Sequence two builder operations.+{-# INLINE then_ #-}+then_ :: Builder1 s f -> Builder1 s f -> Builder1 s f+then_ m1 m2 =+  \s bytearray n i ->+    case m1 s bytearray n i of+      (# s, i #) -> m2 s bytearray n i++-- checked j m executes m only if the array has room for j more symbols.+{-# INLINE checked #-}+checked :: Int -> Builder1 s f -> Builder1 s f+checked j m =+  getSize $ \n ->+  getIndex $ \i ->+  if i + j <= n then m else putIndex (i + j)++-- Emit an arbitrary symbol, with given arguments.+{-# INLINE emitSymbolBuilder #-}+emitSymbolBuilder :: Symbol -> Builder f -> Builder f+emitSymbolBuilder x inner =+  Builder $ checked 1 $+    getByteArray $ \bytearray ->+    -- Skip the symbol itself, then fill it in at the end, when we know the size+    -- of the symbol's arguments.+    getIndex $ \n ->+    putIndex (n+1) `then_`+    unBuilder inner `then_`+    -- Fill in the symbol.+    getIndex (\m ->+      liftST $ writeByteArray bytearray n (fromSymbol x { size = m - n }))++-- Emit a function application.+{-# INLINE emitApp #-}+emitApp :: Fun f -> Builder f -> Builder f+emitApp (F n) inner = emitSymbolBuilder (Symbol True n 0) inner++-- Emit a variable.+{-# INLINE emitVar #-}+emitVar :: Var -> Builder f+emitVar x = emitSymbolBuilder (Symbol False (var_id x) 1) mempty++-- Emit a whole termlist.+{-# INLINE emitTermList #-}+emitTermList :: TermList f -> Builder f+emitTermList (TermList lo hi array) =+  Builder $ checked (hi-lo) $+    getByteArray $ \mbytearray ->+    getIndex $ \n ->+    let k = sizeOf (fromSymbol undefined) in+    liftST (copyByteArray mbytearray (n*k) array (lo*k) ((hi-lo)*k)) `then_`+    putIndex (n + hi-lo)++----------------------------------------------------------------------+-- Efficient subterm testing.+----------------------------------------------------------------------++-- | Is a term contained as a subterm in a given termlist?+{-# INLINE isSubtermOfList #-}+isSubtermOfList :: Term f -> TermList f -> Bool+isSubtermOfList t u =+  isSubArrayOf (singleton t) u++-- N.B. this one should not be exported from Twee.Term+-- because subarray is not the same as subterm if t is not+-- a singleton+isSubArrayOf :: TermList f -> TermList f -> Bool+isSubArrayOf t u =+  lenList t <= lenList u && (here t u || next t u)+  where+    here Empty _ = True+    here (ConsSym s1 t) (UnsafeConsSym s2 u) =+      root s1 == root s2 && here t u++    -- This is safe because lenList t <= lenList u+    -- so if u = Empty, then t = Empty and here t u = True.+    next t (UnsafeConsSym _ u) = isSubArrayOf t u++-- | Check if a variable occurs in a termlist.+{-# INLINE occursList #-}+occursList :: Var -> TermList f -> Bool+occursList (V x) t = symbolOccursList (fromSymbol (Symbol False x 1)) t++symbolOccursList :: Int64 -> TermList f -> Bool+symbolOccursList !_ Empty = False+symbolOccursList n (ConsSym t ts) = root t == n || symbolOccursList n ts
+ Twee/Utils.hs view
@@ -0,0 +1,145 @@+-- | Miscellaneous utility functions.++{-# LANGUAGE CPP, MagicHash #-}+module Twee.Utils where++import Control.Arrow((&&&))+import Control.Exception+import Data.List(groupBy, sortBy)+import Data.Ord(comparing)+import System.IO+import GHC.Prim+import GHC.Types+import Data.Bits+--import Test.QuickCheck hiding ((.&.))++repeatM :: Monad m => m a -> m [a]+repeatM = sequence . repeat++partitionBy :: Ord b => (a -> b) -> [a] -> [[a]]+partitionBy value =+  map (map fst) .+  groupBy (\x y -> snd x == snd y) .+  sortBy (comparing snd) .+  map (id &&& value)++collate :: Ord a => ([b] -> c) -> [(a, b)] -> [(a, c)]+collate f = map g . partitionBy fst+  where+    g xs = (fst (head xs), f (map snd xs))++isSorted :: Ord a => [a] -> Bool+isSorted xs = and (zipWith (<=) xs (tail xs))++isSortedBy :: Ord b => (a -> b) -> [a] -> Bool+isSortedBy f xs = isSorted (map f xs)++usort :: Ord a => [a] -> [a]+usort = usortBy compare++usortBy :: (a -> a -> Ordering) -> [a] -> [a]+usortBy f = map head . groupBy (\x y -> f x y == EQ) . sortBy f++sortBy' :: Ord b => (a -> b) -> [a] -> [a]+sortBy' f = map snd . sortBy (comparing fst) . map (\x -> (f x, x))++usortBy' :: Ord b => (a -> b) -> [a] -> [a]+usortBy' f = map snd . usortBy (comparing fst) . map (\x -> (f x, x))++orElse :: Ordering -> Ordering -> Ordering+EQ `orElse` x = x+x  `orElse` _ = x++unbuffered :: IO a -> IO a+unbuffered x = do+  buf <- hGetBuffering stdout+  bracket_+    (hSetBuffering stdout NoBuffering)+    (hSetBuffering stdout buf)+    x++newtype Max a = Max { getMax :: Maybe a }++getMaxWith :: Ord a => a -> Max a -> a+getMaxWith x (Max (Just y)) = x `max` y+getMaxWith x (Max Nothing)  = x++instance Ord a => Monoid (Max a) where+  mempty = Max Nothing+  Max (Just x) `mappend` y = Max (Just (getMaxWith x y))+  Max Nothing  `mappend` y = y++newtype Min a = Min { getMin :: Maybe a }++getMinWith :: Ord a => a -> Min a -> a+getMinWith x (Min (Just y)) = x `min` y+getMinWith x (Min Nothing)  = x++instance Ord a => Monoid (Min a) where+  mempty = Min Nothing+  Min (Just x) `mappend` y = Min (Just (getMinWith x y))+  Min Nothing  `mappend` y = y++labelM :: Monad m => (a -> m b) -> [a] -> m [(a, b)]+labelM f = mapM (\x -> do { y <- f x; return (x, y) })++#if __GLASGOW_HASKELL__ < 710+isSubsequenceOf :: Ord a => [a] -> [a] -> Bool+[] `isSubsequenceOf` ys = True+(x:xs) `isSubsequenceOf` [] = False+(x:xs) `isSubsequenceOf` (y:ys)+  | x == y = xs `isSubsequenceOf` ys+  | otherwise = (x:xs) `isSubsequenceOf` ys+#endif++{-# INLINE fixpoint #-}+fixpoint :: Eq a => (a -> a) -> a -> a+fixpoint f x = fxp x+  where+    fxp x+      | x == y = x+      | otherwise = fxp y+      where+        y = f x++-- From "Bit twiddling hacks": branchless min and max+{-# INLINE intMin #-}+intMin :: Int -> Int -> Int+intMin x y =+  y `xor` ((x `xor` y) .&. negate (x .<. y))+  where+    I# x .<. I# y = I# (x <# y)++{-# INLINE intMax #-}+intMax :: Int -> Int -> Int+intMax x y =+  x `xor` ((x `xor` y) .&. negate (x .<. y))+  where+    I# x .<. I# y = I# (x <# y)++-- Split an interval (inclusive bounds) into a particular number of blocks+splitInterval :: Integral a => a -> (a, a) -> [(a, a)]+splitInterval k (lo, hi) =+  [ (lo+i*blockSize, (lo+(i+1)*blockSize-1) `min` hi)+  | i <- [0..k-1] ]+  where+    size = (hi-lo+1)+    blockSize = (size + k - 1) `div` k -- division rounding up+{-+prop_split_1 (Positive k) (lo, hi) =+  -- Check that all elements occur exactly once+  concat [[x..y] | (x, y) <- splitInterval k (lo, hi)] === [lo..hi]++-- Check that we have the correct number and distribution of blocks+prop_split_2 (Positive k) (lo, hi) =+  counterexample (show splits) $ conjoin+    [counterexample "Reason: too many splits" $+       length splits <= k,+     counterexample "Reason: too few splits" $+       length [lo..hi] >= k ==> length splits == k,+     counterexample "Reason: uneven distribution" $+      not (null splits) ==>+       minimum (map length splits) + 1 >= maximum (map length splits)]+  where+    splits = splitInterval k (lo, hi)+-}
− misc/analyse_trace.pl 
@@ -1,32 +0,0 @@-:- use_module(boo067_good, []).-:- use_module(boo067_bad, []).--ground(Pred, X) :--	call(Pred, Y),-	numbervars(Y, 1, _),-	X=Y.--default(Pred, X) :--    call(Pred, boo067_good, boo067_bad, X).--missing(X) :- default(missing, X).-missing(Good, Bad, X) :--	ground(Good:lemma, X),-	\+ found(Bad, add(rule(_, X))).--variant(rule(N, X=Y), rule(N, X=Y)).-variant(rule(N, X=Y), rule(N, Y=X)).--found(Mod, Rule) :--	variant(Rule, Rule1),-	Mod:step(add(Rule1)).--gone(Mod, rule(N, X)) :--	ground(Mod:lemma, X),-	found(Mod, rule(N, X)),-	Mod:step(delete(N)).--reappeared(Mod, rule(N, X), M) :--	ground(found(Mod), rule(N, X)),-	found(Mod, rule(M, X)),-	M > N.
− misc/bench.hs 
@@ -1,74 +0,0 @@-{-# LANGUAGE PatternGuards, FlexibleInstances #-}-import Criterion.Main-import Twee.Term hiding (isFun)-import qualified Twee.Term-import Test.QuickCheck-import Data.Int-import Data.Maybe-import Twee.Term.Core hiding (subst)--instance Num (Fun Int) where fromInteger n = F (fromInteger n) (fromInteger n)-instance Num Var where fromInteger = V . fromInteger--t0, t1, u0, u1, t2, t, u :: Term Int-t0 = build $ fun 0 [var 0, fun 0 [var 0, fun 0 [fun 0 [var 0, var 1], var 2]]]-u0 = build $ fun 0 [fun 0 [fun 2 [fun 2 [var 2, var 2], var 1], fun 0 [fun 2 [var 2, var 2], var 3]], fun 0 [fun 0 [fun 2 [fun 2 [var 2, var 2], var 1], fun 0 [fun 2 [var 2, var 2], var 3]], fun 0 [fun 0 [fun 0 [fun 2 [fun 2 [var 2, var 2], var 1], fun 0 [fun 2 [var 2, var 2], var 3]], fun 2 [fun 2 [var 2, var 2], var 1]], fun 2 [var 2, var 2]]]]--t1 = build $ fun 0 [fun 1 [var 0], fun 1 [var 1]]-u1 = build $ fun 0 [fun 1 [fun 0 [fun 2 emptyTermList, fun 3 emptyTermList]], fun 1 [fun 0 [fun 4 emptyTermList, fun 5 emptyTermList]]]--t2 = build $ fun 0 [var 0, fun 1 [var 1, fun 1 [var 1, var 1]]]-u2 = build $ fun 0 [fun 0 [var 2, var 2], var 2]--t = t0-u = u0--Just sub = match t u--mgu1 t u = let Just sub = unifyTri t u in build (subst sub t)-mgu2 t u = let Just sub = unify t u in build (subst sub t)--Just sub' = unifyTri t2 u2-Just csub' = unify t2 u2--main = do-  print t-  print u-  print (match t u)-  print (build (subst sub t))-  print (unifyTri t2 u2)-  print (close sub')-  print (build (subst sub' t2))-  print (build (subst sub' u2))-  print (mgu1 t2 u2)-  print (mgu2 t2 u2)-  print (t == t)-  print (build (subst sub t) == u)-  print (build (subst sub' t2) == build (subst sub' u2))-  print (build (subst csub' t1) == build (subst sub' t1))-  print (mgu1 t2 u2 == mgu2 t2 u2)-  print (build (subst csub' t2) == build (subst sub' t2))-  defaultMain [-    bench "eq-t" (whnf (uncurry (==)) (t, t)),-    bench "eq-u" (whnf (uncurry (==)) (u, u)),-    bench "match" (whnf (fromJust . uncurry match) (t, u)),-    bench "subst" (whnf (build . uncurry subst) (sub, t)),-    bench "unifyTri" (whnf (fromJust . uncurry unifyTri) (t2, u2)),-    bench "unify-close" (whnf (uncurry unify) (t2, u2)),-    bench "unify-subst-iter1" (whnf (build . uncurry subst) (sub', t2)),-    bench "unify-subst-iter2" (whnf (build . uncurry subst) (sub', u2)),-    bench "unify-subst-closed1" (whnf (build . uncurry subst) (csub', t2)),-    bench "unify-subst-closed2" (whnf (build . uncurry subst) (csub', u2)),-    bench "mgu-tri" (whnf (uncurry mgu1) (t2, u2)),-    bench "mgu-close" (whnf (uncurry mgu2) (t2, u2)),-    bench "make-constant" (whnf (build . uncurry fun) (F 0 0, emptyTermList)),-    bench "baseline" (whnf (uncurry (+)) (0 :: Int, 0))]--prop :: Bool -> NonNegative (Small Int) -> NonNegative (Small Int) -> Property-prop fun_ (NonNegative (Small index_)) (NonNegative (Small size_)) =-  (isFun x, index x, size x) === (fun_, index_, size_)-  where-    x = toSymbol (fromSymbol (Symbol fun_ index_ size_))--prop2 :: Int64 -> Property-prop2 x = fromSymbol (toSymbol x) === x
− misc/ring_conn.pl 
@@ -1,801 +0,0 @@-:- module(ring_conn, [step/1, lemma/1]).-:- discontiguous(step/1).-:- discontiguous(lemma/1).-:- style_check(-singleton).-step(add(rule(1, (X1 + X2) = (X2 + X1)))).-step(add(rule(2, ((X1 + X2) + X3) = (X1 + (X2 + X3))))).-step(add(rule(3, (0 + X1) = X1))).-step(add(rule(4, (X1 + -X1) = 0))).-step(add(rule(5, ((X1 * X2) * X3) = (X1 * (X2 * X3))))).-step(add(rule(6, ((X1 * X2) + (X1 * X3)) = (X1 * (X2 + X3))))).-step(add(rule(7, ((X1 * X3) + (X2 * X3)) = ((X1 + X2) * X3)))).-step(add(rule(8, (X1 * (X1 * X1)) = X1))).-step(add(rule(9, -0 = 0))).-step(add(rule(10, (X1 + 0) = X1))).-step(add(rule(11, (X1 + (-X1 + X2)) = X2))).-step(add(rule(12, -(-X1) = X1))).-step(add(rule(13, (X1 + (X2 + X3)) = (X3 + (X1 + X2))))).-step(add(rule(14, (X1 + (X2 + X3)) = (X2 + (X1 + X3))))).-step(add(rule(15, ((X1 + X1) * X2) = (X1 * (X2 + X2))))).-step(add(rule(16, (X2 + (X1 + -X2)) = X1))).-step(add(rule(17, (0 * (X1 + X1)) = (0 * X1)))).-step(add(rule(18, (X1 * (X1 * (X1 * X2))) = (X1 * X2)))).-step(hard((X1 + (X2 + X3)) = (X3 + (X2 + X1)))).-step(hard((X1 + (X2 + X3)) = (X1 + (X3 + X2)))).-step(add(rule(19, (X1 + (X2 + -(X1 + X2))) = 0))).-step(add(rule(20, (X1 + -(-X2 + X1)) = X2))).-step(add(rule(21, (X1 * ((X1 * X1) + X2)) = (X1 + (X1 * X2))))).-step(add(rule(22, (X1 + (X1 * 0)) = X1))).-step(add(rule(23, (X1 * 0) = 0))).-step(add(rule(24, (X1 * (X2 + (X1 * X1))) = (X1 + (X1 * X2))))).-step(add(rule(25, (X2 + -(X1 + X2)) = -X1))).-step(add(rule(26, ((X1 + X1) * (X1 * X1)) = (X1 + X1)))).-step(hard(0 = (X1 + (X2 + -(X2 + X1))))).-step(add(rule(27, (X2 + -(X2 + -X1)) = X1))).-step(add(rule(28, -(-X1 + -X2) = (X2 + X1)))).-step(add(rule(29, (X1 * (0 * X2)) = (0 * X2)))).-step(add(rule(30, (X1 + (X2 * (X1 * X1))) = ((X1 + X2) * (X1 * X1))))).-step(add(rule(31, (X2 + -(X2 + X1)) = -X1))).-step(hard((-X1 + (X2 + (X3 + X1))) = (X3 + X2))).-step(add(rule(32, (X3 + (X2 + (-X3 + X1))) = (X1 + X2)))).-step(add(rule(33, (X3 + (X1 + (X2 + -X3))) = (X1 + X2)))).-step(add(rule(34, -(X1 + -X2) = (X2 + -X1)))).-step(add(rule(35, (-X1 + -X2) = -(X2 + X1)))).-step(add(rule(36, (X1 + (X1 * -(X1 * X1))) = 0))).-step(add(rule(37, (-X1 * -(-X1 * -X1)) = X1))).-step(add(rule(38, (-X1 * (-X1 * X1)) = X1))).-step(add(rule(39, (X1 * -(X1 * X1)) = -X1))).-step(hard((X1 + (X2 + (X3 + X4))) = (X2 + (X3 + (X4 + X1))))).-step(hard((X1 + (X2 + (X3 + X4))) = (X3 + (X2 + (X4 + X1))))).-step(hard((X1 + (X2 + (X3 + X4))) = (X3 + (X4 + (X1 + X2))))).-step(hard((X1 + (X2 + (X3 + X4))) = (X4 + (X3 + (X1 + X2))))).-step(hard((X1 + (X2 + (X3 + X4))) = (X3 + (X1 + (X2 + X4))))).-step(hard((X1 + (X2 + (X3 + X4))) = (X4 + (X2 + (X3 + X1))))).-step(hard((X1 + (X2 + (X3 + X4))) = (X2 + (X4 + (X1 + X3))))).-step(add(rule(40, ((X1 + X1) * (X2 * X3)) = (X1 * ((X2 + X2) * X3))))).-step(add(rule(41, (X1 * (X1 * (X1 + X1))) = (X1 + X1)))).-step(add(rule(42, (X1 * (X2 * (X3 + X3))) = (X1 * ((X2 + X2) * X3))))).-step(add(rule(43, (X1 + (X1 * (X1 * X2))) = (X1 * (X1 * (X1 + X2)))))).-step(add(rule(44, (X1 + (X1 * (X2 * X1))) = (X1 * ((X1 + X2) * X1))))).-step(add(rule(45, (X1 + (0 * X1)) = X1))).-step(add(rule(46, (0 * X1) = 0))).-step(add(rule(47, (X2 + (X3 + (-(X2 + X3) + X1))) = X1))).-step(hard((X1 + (X2 + (-(X2 + X1) + X3))) = X3)).-step(add(rule(48, (X1 * (X1 * -X1)) = -X1))).-step(add(rule(49, -(-X1 + X2) = (X1 + -X2)))).-step(add(rule(50, ((X1 * X2) + ((X1 * X3) + X4)) = ((X1 * (X2 + X3)) + X4)))).-step(add(rule(51, ((X1 * X2) + ((X3 * X2) + X4)) = (((X1 + X3) * X2) + X4)))).-step(add(rule(52, ((X1 * (X2 * X4)) + (X3 * X4)) = (((X1 * X2) + X3) * X4)))).-step(add(rule(53, (((X1 * X1) + X2) * X1) = (X1 + (X2 * X1))))).-step(add(rule(54, (X1 + (-(X1 * X1) * X1)) = 0))).-step(add(rule(55, (-(X1 * X1) * X1) = -X1))).-step(add(rule(56, ((X1 + (X1 * X2)) * X3) = (X1 * (X3 + (X2 * X3)))))).-step(add(rule(57, ((X2 + (X1 * X1)) * X1) = (X1 + (X2 * X1))))).-step(add(rule(58, ((X1 * X4) + (X2 * (X3 * X4))) = ((X1 + (X2 * X3)) * X4)))).-step(add(rule(59, (X1 * (X2 * (X1 * (X2 * (X1 * X2))))) = (X1 * X2)))).-step(add(rule(60, (X1 * ((X1 * (X1 * X2)) + X3)) = (X1 * (X2 + X3))))).-step(add(rule(61, (X1 * (X2 + (X1 * (X1 * X3)))) = (X1 * (X2 + X3))))).-step(add(rule(62, (X1 * (X2 + X2)) = (X1 * (X1 * ((X1 + X1) * X2)))))).-step(add(rule(63, (X1 * (X1 * (X1 + (X1 * X2)))) = (X1 + (X1 * X2))))).-step(add(rule(64, (X1 + (X1 * (-(X1 * X1) + X2))) = (X1 * X2)))).-step(add(rule(65, ((X1 + X1) * (X2 * X3)) = (X1 * (X2 * (X3 + X3)))))).-step(add(rule(66, (-(X1 * X3) + (X1 * (X2 + X3))) = (X1 * X2)))).-step(add(rule(67, -(X1 * -X2) = (X1 * X2)))).-step(add(rule(68, -(X1 * X2) = (X1 * -X2)))).-step(add(rule(69, (X1 * (X2 * (-X2 * -X2))) = (X1 * X2)))).-step(add(rule(70, (-X1 * (X1 * -X1)) = X1))).-step(add(rule(71, (X1 * (-X1 * -X1)) = X1))).-step(add(rule(72, (-X1 * (X1 * X1)) = -X1))).-step(add(rule(73, (X1 * (-X1 * X1)) = -X1))).-step(add(rule(74, ((X2 * -X3) + ((X1 + X2) * X3)) = (X1 * X3)))).-step(add(rule(75, (-X1 * -X2) = (X1 * X2)))).-step(add(rule(76, (-X1 * X2) = (X1 * -X2)))).-step(add(rule(77, (X2 + (X3 + (X1 + -(X2 + X3)))) = X1))).-step(hard(X1 = (X2 + (X3 + (-(X3 + X2) + X1))))).-step(add(rule(78, ((X1 + (X1 * X1)) * (X1 * X1)) = (X1 + (X1 * X1))))).-step(add(rule(79, (X1 + (X1 * ((X1 + X1) * -X1))) = -X1))).-step(add(rule(80, ((X1 * X2) + (X3 + (X1 * X4))) = (X3 + (X1 * (X4 + X2)))))).-step(add(rule(81, ((X1 * X2) + (X3 + (X4 * X2))) = (X3 + ((X4 + X1) * X2))))).-step(add(rule(82, ((X1 + X2) * (X3 + X3)) = ((X1 + (X2 + (X1 + X2))) * X3)))).-step(add(rule(83, ((X1 + (X1 + X2)) * X3) = ((X1 * (X3 + X3)) + (X2 * X3))))).-step(add(rule(84, ((X1 + (X1 + X1)) * X2) = (X1 * (X2 + (X2 + X2)))))).-step(add(rule(85, ((X1 + (X2 + X2)) * X3) = ((X1 * X3) + (X2 * (X3 + X3)))))).-step(hard(((X1 + X2) * (X3 + X3)) = ((X2 + (X1 + (X2 + X1))) * X3))).-step(add(rule(86, ((X1 + X1) * (X2 + X3)) = (X1 * (X2 + (X3 + (X2 + X3))))))).-step(add(rule(87, (X1 * (X2 + (X2 + X3))) = (((X1 + X1) * X2) + (X1 * X3))))).-step(add(rule(88, (X1 * (X2 + (X3 + X3))) = ((X1 * X2) + ((X1 + X1) * X3))))).-step(add(rule(89, (X1 + (X1 * (X2 + X2))) = (X1 + ((X1 + X1) * X2))))).-step(add(rule(90, (X1 * -(X2 + X2)) = ((X1 + X1) * -X2)))).-step(hard(((X1 + X1) * (X2 + X3)) = (X1 * (X3 + (X2 + (X3 + X2)))))).-step(add(rule(91, (X1 * (((X1 * X1) + X2) * X3)) = ((X1 + (X1 * X2)) * X3)))).-step(add(rule(92, (X1 * (X3 + ((X1 * X1) + X2))) = (X1 + (X1 * (X2 + X3)))))).-step(add(rule(93, (X1 * (X2 + (X3 + (X1 * X1)))) = (X1 + (X1 * (X2 + X3)))))).-step(add(rule(94, (X1 * ((X2 + (X1 * X1)) * X3)) = ((X1 + (X1 * X2)) * X3)))).-step(add(rule(95, (X1 + (-(X2 + X1) + X3)) = (-X2 + X3)))).-step(add(rule(96, (X3 + -(X1 + (X2 + X3))) = -(X1 + X2)))).-step(add(rule(97, (X1 + (X2 + -(X3 + X1))) = (X2 + -X3)))).-step(add(rule(98, (((X1 * X1) + X2) * (X1 * X3)) = ((X1 + (X2 * X1)) * X3)))).-step(add(rule(99, ((X1 + (X2 * X3)) * (X3 * X3)) = (((X1 * X3) + X2) * X3)))).-step(add(rule(100, ((X1 + (X2 * X2)) * (X2 * X3)) = ((X2 + (X1 * X2)) * X3)))).-step(add(rule(101, (X1 * (X1 * -(X1 + X1))) = -(X1 + X1)))).-step(add(rule(102, (X1 * (X1 * ((X1 + X1) * X2))) = ((X1 + X1) * X2)))).-step(add(rule(103, ((X1 + (X1 + X1)) * (X1 * X1)) = (X1 + (X1 + X1))))).-step(add(rule(104, ((X1 + (X1 * (X2 * X2))) * X2) = (X1 * (X2 + X2))))).-step(add(rule(105, (((X1 * (X2 * X2)) + X3) * X2) = ((X1 + X3) * X2)))).-step(add(rule(106, (X1 + (X1 * (X2 + (X1 * -X1)))) = (X1 * X2)))).-step(add(rule(107, (X1 + (((X1 * -X1) + X2) * X1)) = (X2 * X1)))).-step(add(rule(108, (X1 + ((X2 + (X1 * -X1)) * X1)) = (X2 * X1)))).-step(add(rule(109, (X1 + ((-X2 + (X1 * X1)) * -X1)) = (X2 * X1)))).-step(add(rule(110, ((X3 * -X2) + ((X3 + X1) * X2)) = (X1 * X2)))).-step(hard(X1 = (X2 + (X3 + (X1 + -(X3 + X2)))))).-step(add(rule(111, ((X3 * X2) + ((X1 + X3) * -X2)) = (X1 * -X2)))).-step(add(rule(112, ((X1 + (X1 + (X1 + X1))) * X2) = (X1 * (X2 + (X2 + (X2 + X2))))))).-step(add(rule(113, ((X1 * X3) + (X2 * (X1 * (X1 * X3)))) = ((X1 + X2) * (X1 * (X1 * X3)))))).-step(add(rule(114, (X1 * ((X1 + X1) * ((X1 + X1) * (X2 + X2)))) = ((X1 + X1) * X2)))).-step(add(rule(115, (((X1 + X2) * (X1 * X1)) + X3) = (X1 + ((X2 * (X1 * X1)) + X3))))).-step(interreduce).-step(delete(rule(11, (X1 + (-X1 + X2)) = X2))).-step(delete(rule(13, (X1 + (X2 + X3)) = (X3 + (X1 + X2))))).-step(delete(rule(17, (0 * (X1 + X1)) = (0 * X1)))).-step(delete(rule(19, (X1 + (X2 + -(X1 + X2))) = 0))).-step(delete(rule(20, (X1 + -(-X2 + X1)) = X2))).-step(delete(rule(21, (X1 * ((X1 * X1) + X2)) = (X1 + (X1 * X2))))).-step(delete(rule(22, (X1 + (X1 * 0)) = X1))).-step(delete(rule(25, (X2 + -(X1 + X2)) = -X1))).-step(delete(rule(26, ((X1 + X1) * (X1 * X1)) = (X1 + X1)))).-step(delete(rule(27, (X2 + -(X2 + -X1)) = X1))).-step(delete(rule(28, -(-X1 + -X2) = (X2 + X1)))).-step(delete(rule(29, (X1 * (0 * X2)) = (0 * X2)))).-step(delete(rule(36, (X1 + (X1 * -(X1 * X1))) = 0))).-step(delete(rule(37, (-X1 * -(-X1 * -X1)) = X1))).-step(delete(rule(38, (-X1 * (-X1 * X1)) = X1))).-step(delete(rule(39, (X1 * -(X1 * X1)) = -X1))).-step(delete(rule(45, (X1 + (0 * X1)) = X1))).-step(delete(rule(47, (X2 + (X3 + (-(X2 + X3) + X1))) = X1))).-step(delete(rule(50, ((X1 * X2) + ((X1 * X3) + X4)) = ((X1 * (X2 + X3)) + X4)))).-step(delete(rule(51, ((X1 * X2) + ((X3 * X2) + X4)) = (((X1 + X3) * X2) + X4)))).-step(delete(rule(53, (((X1 * X1) + X2) * X1) = (X1 + (X2 * X1))))).-step(delete(rule(54, (X1 + (-(X1 * X1) * X1)) = 0))).-step(delete(rule(55, (-(X1 * X1) * X1) = -X1))).-step(delete(rule(60, (X1 * ((X1 * (X1 * X2)) + X3)) = (X1 * (X2 + X3))))).-step(delete(rule(62, (X1 * (X2 + X2)) = (X1 * (X1 * ((X1 + X1) * X2)))))).-step(delete(rule(64, (X1 + (X1 * (-(X1 * X1) + X2))) = (X1 * X2)))).-step(delete(rule(66, (-(X1 * X3) + (X1 * (X2 + X3))) = (X1 * X2)))).-step(delete(rule(67, -(X1 * -X2) = (X1 * X2)))).-step(delete(rule(69, (X1 * (X2 * (-X2 * -X2))) = (X1 * X2)))).-step(delete(rule(70, (-X1 * (X1 * -X1)) = X1))).-step(delete(rule(71, (X1 * (-X1 * -X1)) = X1))).-step(delete(rule(72, (-X1 * (X1 * X1)) = -X1))).-step(delete(rule(73, (X1 * (-X1 * X1)) = -X1))).-step(delete(rule(74, ((X2 * -X3) + ((X1 + X2) * X3)) = (X1 * X3)))).-step(delete(rule(75, (-X1 * -X2) = (X1 * X2)))).-step(delete(rule(77, (X2 + (X3 + (X1 + -(X2 + X3)))) = X1))).-step(delete(rule(78, ((X1 + (X1 * X1)) * (X1 * X1)) = (X1 + (X1 * X1))))).-step(delete(rule(79, (X1 + (X1 * ((X1 + X1) * -X1))) = -X1))).-step(delete(rule(91, (X1 * (((X1 * X1) + X2) * X3)) = ((X1 + (X1 * X2)) * X3)))).-step(delete(rule(95, (X1 + (-(X2 + X1) + X3)) = (-X2 + X3)))).-step(delete(rule(98, (((X1 * X1) + X2) * (X1 * X3)) = ((X1 + (X2 * X1)) * X3)))).-step(delete(rule(107, (X1 + (((X1 * -X1) + X2) * X1)) = (X2 * X1)))).-step(add(rule(116, (X1 + (X2 * (X3 * (X1 * X1)))) = ((X1 + (X2 * X3)) * (X1 * X1))))).-step(add(rule(117, (X1 + (X2 + (X3 * (X1 * X1)))) = (X2 + ((X1 + X3) * (X1 * X1)))))).-step(add(rule(118, (X1 * (X1 * (X1 + (X1 + X1)))) = (X1 + (X1 + X1))))).-step(add(rule(119, ((X1 + (X2 + X2)) * (X1 * X1)) = (X1 + (X2 * (X1 * (X1 + X1))))))).-step(add(rule(120, (X1 + (X1 * (X2 * (X3 * X1)))) = (X1 * (((X2 * X3) + X1) * X1))))).-step(add(rule(121, ((X2 * -X3) + (X1 * X3)) = ((X1 + -X2) * X3)))).-step(add(rule(122, (X1 + (-(X1 + X2) + X3)) = (-X2 + X3)))).-step(add(rule(123, (X1 + (X2 + -(X1 + X3))) = (X2 + -X3)))).-step(add(rule(124, (X3 + -(X1 + (X3 + X2))) = -(X1 + X2)))).-step(add(rule(125, (X1 * (X1 * (X2 + (X1 * X3)))) = (X1 * ((X1 * X2) + X3))))).-step(add(rule(126, ((X3 + (X3 + (X2 + X2))) * X4) = ((X3 + X2) * (X4 + X4))))).-step(hard(((X1 + X2) * (X3 + X3)) = ((X1 + (X2 + (X2 + X1))) * X3))).-step(hard(((X1 + X2) * (X3 + X3)) = ((X2 + (X1 + (X1 + X2))) * X3))).-step(hard(((X1 * (X2 + X2)) + (X3 * X2)) = ((X1 + (X3 + X1)) * X2))).-step(add(rule(127, ((X1 + (X1 + X2)) * X3) = ((X2 * X3) + (X1 * (X3 + X3)))))).-step(hard(((X1 + (X1 + X2)) * X3) = ((X2 + (X1 + X1)) * X3))).-step(hard(((X1 * X2) + (X3 * (X2 + X2))) = ((X3 + (X1 + X3)) * X2))).-step(hard(((X1 + (X2 + X2)) * X3) = ((X2 * (X3 + X3)) + (X1 * X3)))).-step(add(rule(128, (X1 * (X4 + (X4 + (X3 + X3)))) = ((X1 + X1) * (X4 + X3))))).-step(hard(((X1 + X1) * (X2 + X3)) = (X1 * (X2 + (X3 + (X3 + X2)))))).-step(hard(((X1 + X1) * (X2 + X3)) = (X1 * (X3 + (X2 + (X2 + X3)))))).-step(hard((((X1 + X1) * X2) + (X1 * X3)) = (X1 * (X2 + (X3 + X2))))).-step(add(rule(129, (X1 * (X2 + (X2 + X3))) = ((X1 * X3) + ((X1 + X1) * X2))))).-step(hard((X1 * (X2 + (X2 + X3))) = (X1 * (X3 + (X2 + X2))))).-step(hard(((X1 * X2) + ((X1 + X1) * X3)) = (X1 * (X3 + (X2 + X3))))).-step(hard((X1 * (X2 + (X3 + X3))) = (((X1 + X1) * X3) + (X1 * X2)))).-step(add(rule(130, (X1 * ((X1 * (X1 * X2)) + (X3 + X3))) = ((X1 * X2) + ((X1 + X1) * X3))))).-step(add(rule(131, (((X3 * X2) + X1) * (X2 * X2)) = (((X1 * X2) + X3) * X2)))).-step(add(rule(132, (X2 + (-X2 + (X1 * -X2))) = (X1 * -X2)))).-step(add(rule(133, (X1 * ((X1 + X1) * (X1 + (X1 + (X1 + X1))))) = (X1 + X1)))).-step(add(rule(134, (X4 + (X2 + (X3 + (-X4 + X1)))) = (X1 + (X2 + X3))))).-step(add(rule(135, -(X1 + (-X2 + X3)) = (X2 + -(X3 + X1))))).-step(add(rule(136, (X4 + (X1 + (X2 + (X3 + -X4)))) = (X1 + (X2 + X3))))).-step(add(rule(137, -(X1 + (X2 + -X3)) = (X3 + -(X1 + X2))))).-step(add(rule(138, (-X1 + (-X2 + X3)) = (-(X2 + X1) + X3)))).-step(add(rule(139, (-X1 + (X2 + -X3)) = (X2 + -(X3 + X1))))).-step(add(rule(140, -(X3 + (X1 * -X2)) = ((X1 * X2) + -X3)))).-step(add(rule(141, ((X2 * -X3) + -X1) = -(X1 + (X2 * X3))))).-step(add(rule(142, (-X3 + (X1 * -X2)) = -((X1 * X2) + X3)))).-step(add(rule(143, ((X1 + -X2) * -X3) = ((X2 + -X1) * X3)))).-step(add(rule(144, ((X2 + (X1 * (X3 * X3))) * X3) = ((X1 + X2) * X3)))).-step(add(rule(145, ((X1 + X1) * (X1 + (X1 + (X1 + X1)))) = (X1 * (X1 + X1))))).-step(add(rule(146, (X1 + (X1 * ((X1 * -X1) + X2))) = (X1 * X2)))).-step(add(rule(147, (X2 + (-X2 + (X1 * X2))) = (X1 * X2)))).-step(add(rule(148, ((X1 * (X2 + X2)) + ((X1 + X1) * X3)) = ((X1 + X1) * (X2 + X3))))).-step(add(rule(149, (((X1 + X1) * X2) + (X1 * (X3 + X3))) = ((X1 + X1) * (X2 + X3))))).-step(add(rule(150, (X1 + (X1 + ((X1 + X1) * X2))) = ((X1 + X1) * (X2 + (X1 * X1)))))).-step(add(rule(151, (((X1 + X1) * X3) + (X2 * (X3 + X3))) = ((X1 + X2) * (X3 + X3))))).-step(add(rule(152, ((X1 * (X3 + X3)) + ((X2 + X2) * X3)) = ((X1 + X2) * (X3 + X3))))).-step(add(rule(153, (((X1 + X1) * -X2) + X3) = ((X1 * -(X2 + X2)) + X3)))).-step(add(rule(154, ((X1 * (X2 + X2)) + X3) = (((X1 + X1) * X2) + X3)))).-step(add(rule(155, (X1 + ((X2 + X2) * X3)) = (X1 + (X2 * (X3 + X3)))))).-step(add(rule(156, (X1 + ((X1 + (X1 * X1)) * -X1)) = (X1 * -X1)))).-step(add(rule(157, (X2 + ((X1 + (X2 * X2)) * -X2)) = (X1 * -X2)))).-step(add(rule(158, ((((X2 * -X2) + X1) * -X2) + X3) = (X2 + (X3 + (X1 * -X2)))))).-step(add(rule(159, ((X3 * X2) + ((X3 + X1) * -X2)) = (X1 * -X2)))).-step(add(rule(160, (((? * X2) + ((? * X2) + ((X3 + ?) * -(X2 + X2)))) * X4) = (X3 * (X2 * -(X4 + X4)))))).-step(add(rule(161, (((X1 * X2) + ((X1 * X2) + ((X3 + X1) * -(X2 + X2)))) * X4) = (((? * X2) + ((? * X2) + ((X3 + ?) * -(X2 + X2)))) * X4)))).-step(interreduce).-step(delete(rule(63, (X1 * (X1 * (X1 + (X1 * X2)))) = (X1 + (X1 * X2))))).-step(delete(rule(82, ((X1 + X2) * (X3 + X3)) = ((X1 + (X2 + (X1 + X2))) * X3)))).-step(delete(rule(85, ((X1 + (X2 + X2)) * X3) = ((X1 * X3) + (X2 * (X3 + X3)))))).-step(delete(rule(86, ((X1 + X1) * (X2 + X3)) = (X1 * (X2 + (X3 + (X2 + X3))))))).-step(delete(rule(88, (X1 * (X2 + (X3 + X3))) = ((X1 * X2) + ((X1 + X1) * X3))))).-step(delete(rule(89, (X1 + (X1 * (X2 + X2))) = (X1 + ((X1 + X1) * X2))))).-step(delete(rule(96, (X3 + -(X1 + (X2 + X3))) = -(X1 + X2)))).-step(delete(rule(104, ((X1 + (X1 * (X2 * X2))) * X2) = (X1 * (X2 + X2))))).-step(delete(rule(105, (((X1 * (X2 * X2)) + X3) * X2) = ((X1 + X3) * X2)))).-step(delete(rule(109, (X1 + ((-X2 + (X1 * X1)) * -X1)) = (X2 * X1)))).-step(delete(rule(110, ((X3 * -X2) + ((X3 + X1) * X2)) = (X1 * X2)))).-step(delete(rule(111, ((X3 * X2) + ((X1 + X3) * -X2)) = (X1 * -X2)))).-step(delete(rule(122, (X1 + (-(X1 + X2) + X3)) = (-X2 + X3)))).-step(delete(rule(132, (X2 + (-X2 + (X1 * -X2))) = (X1 * -X2)))).-step(delete(rule(133, (X1 * ((X1 + X1) * (X1 + (X1 + (X1 + X1))))) = (X1 + X1)))).-step(delete(rule(134, (X4 + (X2 + (X3 + (-X4 + X1)))) = (X1 + (X2 + X3))))).-step(delete(rule(135, -(X1 + (-X2 + X3)) = (X2 + -(X3 + X1))))).-step(delete(rule(138, (-X1 + (-X2 + X3)) = (-(X2 + X1) + X3)))).-step(delete(rule(156, (X1 + ((X1 + (X1 * X1)) * -X1)) = (X1 * -X1)))).-step(delete(rule(160, (((? * X2) + ((? * X2) + ((X3 + ?) * -(X2 + X2)))) * X4) = (X3 * (X2 * -(X4 + X4)))))).-step(add(rule(162, (((? * X2) + ((? * X2) + ((? + X3) * -(X2 + X2)))) * X4) = (X3 * (X2 * -(X4 + X4)))))).-step(delete(rule(161, (((X1 * X2) + ((X1 * X2) + ((X3 + X1) * -(X2 + X2)))) * X4) = (((? * X2) + ((? * X2) + ((X3 + ?) * -(X2 + X2)))) * X4)))).-step(add(rule(163, (((X1 * X2) + ((X1 * X2) + ((X3 + X1) * -(X2 + X2)))) * X4) = (((? * X2) + ((? * X2) + ((? + X3) * -(X2 + X2)))) * X4)))).-step(add(rule(164, (X1 * (X2 * ((X3 + X3) * X4))) = ((X1 + X1) * (X2 * (X3 * X4)))))).-step(add(rule(165, (X1 * (X2 * ((X3 + X3) * X4))) = (X1 * ((X2 + X2) * (X3 * X4)))))).-step(add(rule(166, ((X1 + X1) * (X2 * ((X2 + X2) * (X2 + X2)))) = (X1 * (X2 + X2))))).-step(add(rule(167, (X1 * (X2 * (X3 * (X4 + X4)))) = (X1 * (X2 * ((X3 + X3) * X4)))))).-step(add(rule(168, (X1 * (((X2 + X2) * X3) + X4)) = (X1 * ((X2 * (X3 + X3)) + X4))))).-step(add(rule(169, (X1 * (X2 + ((X3 + X3) * X4))) = (X1 * (X2 + (X3 * (X4 + X4))))))).-step(add(rule(170, ((X1 * (X1 * (X1 + X2))) + X3) = (X1 + ((X1 * (X1 * X2)) + X3))))).-step(add(rule(171, (X1 + (X2 + (X1 * (X1 * X3)))) = (X2 + (X1 * (X1 * (X1 + X3))))))).-step(add(rule(172, (X1 * (X1 * (X1 + (X2 + X2)))) = (X1 + (X1 * ((X1 + X1) * X2)))))).-step(add(rule(173, ((X1 * ((X1 + X2) * X1)) + X3) = (X1 + ((X1 * (X2 * X1)) + X3))))).-step(add(rule(174, (X1 + (X2 + (X1 * (X3 * X1)))) = (X2 + (X1 * ((X1 + X3) * X1)))))).-step(add(rule(175, (X1 * ((X1 + (X2 + X2)) * X1)) = (X1 + (X1 * (X2 * (X1 + X1))))))).-step(add(rule(176, ((((X1 + X1) * X2) + X3) * X4) = (((X1 * (X2 + X2)) + X3) * X4)))).-step(add(rule(177, ((X1 + (X1 * X2)) * (X3 * X4)) = (X1 * ((X3 + (X2 * X3)) * X4))))).-step(add(rule(178, (X1 * (X2 * (X3 + (X4 * X3)))) = (X1 * ((X2 + (X2 * X4)) * X3))))).-step(add(rule(179, (X1 * (X2 + ((X3 + X3) * X2))) = ((X1 + ((X1 + X1) * X3)) * X2)))).-step(add(rule(180, (X1 * (X2 + (X1 * (X3 * X2)))) = (X1 * (X1 * ((X1 + X3) * X2)))))).-step(add(rule(181, (X1 * (X2 + (X3 * (X1 * X2)))) = (X1 * ((X1 + X3) * (X1 * X2)))))).-step(add(rule(182, ((X1 + (X1 * (X2 * X3))) * X4) = (X1 * (X4 + (X2 * (X3 * X4))))))).-step(add(rule(183, ((X1 + (X1 * (X2 + X2))) * X3) = (X1 * (X3 + (X2 * (X3 + X3))))))).-step(add(rule(184, ((X1 + ((X2 + X2) * X3)) * X4) = ((X1 + (X2 * (X3 + X3))) * X4)))).-step(add(rule(185, (X1 * -(X2 + (X1 * X1))) = -(X1 + (X1 * X2))))).-step(add(rule(186, ((X1 + (X2 * X2)) * -X2) = -(X2 + (X1 * X2))))).-step(add(rule(187, ((X2 * X1) + -(X1 + (X2 * X1))) = -X1))).-step(add(rule(188, ((X1 * X3) + (X2 * -X3)) = ((X1 + -X2) * X3)))).-step(add(rule(189, ((X1 * X2) + (X3 * (X2 + X4))) = ((X3 * X4) + ((X1 + X3) * X2))))).-step(hard(((X1 + (X3 + X1)) * X2) = ((X3 + (X1 + X1)) * X2))).-step(hard(((X1 + (X3 + X1)) * X2) = ((X1 + (X1 + X3)) * X2))).-step(add(rule(190, (X1 + (X1 * ((X1 * X2) + X3))) = (X1 * (X3 + (X1 * (X1 + X2))))))).-step(add(rule(191, (X1 + (X1 * ((X2 * X1) + X3))) = (X1 * (X3 + ((X1 + X2) * X1)))))).-step(hard(((X1 + (X1 + X2)) * (X2 * X2)) = (X2 + (X1 * (X2 * (X2 + X2)))))).-step(hard((X1 + (X1 * (X2 * (X1 + X1)))) = (X1 * ((X2 + (X2 + X1)) * X1)))).-step(hard((X1 + (X1 * ((X1 + X1) * X2))) = (X1 * (X1 * (X2 + (X2 + X1)))))).-step(add(rule(192, (X1 * ((X2 * X3) + ((X2 * X3) + X4))) = (X1 * (((X2 + X2) * X3) + X4))))).-step(add(rule(193, (X1 * (X2 + (X2 + (X3 * X2)))) = ((X1 + (X1 + (X1 * X3))) * X2)))).-step(add(rule(194, (X1 + (X1 + (X1 * (X2 + X2)))) = ((X1 + X1) * ((X1 * X1) + X2))))).-step(add(rule(195, (X1 + (X1 * (X2 + (X1 * X3)))) = (X1 * (X2 + (X1 * (X3 + X1))))))).-step(add(rule(196, (X1 + (X1 * (X2 + (X3 * X1)))) = (X1 * (X2 + ((X3 + X1) * X1)))))).-step(add(rule(197, ((X1 + (X2 + (X1 * X1))) * (X1 * X1)) = (X1 + ((X1 + (X2 * X1)) * X1))))).-step(add(rule(198, ((X1 + (X2 * -X2)) * -X2) = (X2 + (X1 * -X2))))).-step(add(rule(199, (((X2 + X1) * (X1 * X1)) + X3) = (X1 + ((X2 * (X1 * X1)) + X3))))).-step(add(rule(200, (X1 + (((X2 * X1) + X3) * X1)) = ((((X1 + X2) * X1) + X3) * X1)))).-step(add(rule(201, (X1 + ((X2 + X3) * (X2 * X2))) = (X2 + ((X3 * (X2 * X2)) + X1))))).-step(add(rule(202, ((X1 + ((X1 * X1) + X2)) * (X1 * X1)) = ((X1 + ((X2 + X1) * X1)) * X1)))).-step(add(rule(203, (X1 + (X2 + (X3 * (X1 * X1)))) = (X2 + ((X3 + X1) * (X1 * X1)))))).-step(add(rule(204, (X1 + ((X2 + (X3 * X1)) * X1)) = ((X2 + ((X1 + X3) * X1)) * X1)))).-step(hard((X1 + (X2 * (X1 * (X1 + X1)))) = ((X2 + (X1 + X2)) * (X1 * X1)))).-step(add(rule(205, ((X1 + X1) * (X2 + (X2 + X2))) = ((X1 + (X1 + X1)) * (X2 + X2))))).-step(add(rule(206, (X1 * (X2 + (X2 + (X1 * (X1 + X1))))) = ((X1 + X1) * (X2 + (X1 * X1)))))).-step(simplify_queue).-step(interreduce).-step(delete(rule(106, (X1 + (X1 * (X2 + (X1 * -X1)))) = (X1 * X2)))).-step(delete(rule(117, (X1 + (X2 + (X3 * (X1 * X1)))) = (X2 + ((X1 + X3) * (X1 * X1)))))).-step(delete(rule(121, ((X2 * -X3) + (X1 * X3)) = ((X1 + -X2) * X3)))).-step(delete(rule(146, (X1 + (X1 * ((X1 * -X1) + X2))) = (X1 * X2)))).-step(delete(rule(157, (X2 + ((X1 + (X2 * X2)) * -X2)) = (X1 * -X2)))).-step(delete(rule(158, ((((X2 * -X2) + X1) * -X2) + X3) = (X2 + (X3 + (X1 * -X2)))))).-step(delete(rule(159, ((X3 * X2) + ((X3 + X1) * -X2)) = (X1 * -X2)))).-step(delete(rule(190, (X1 + (X1 * ((X1 * X2) + X3))) = (X1 * (X3 + (X1 * (X1 + X2))))))).-step(delete(rule(191, (X1 + (X1 * ((X2 * X1) + X3))) = (X1 * (X3 + ((X1 + X2) * X1)))))).-step(delete(rule(197, ((X1 + (X2 + (X1 * X1))) * (X1 * X1)) = (X1 + ((X1 + (X2 * X1)) * X1))))).-step(add(rule(207, ((X1 + (X2 + (X1 * X1))) * (X1 * X1)) = ((X1 + ((X1 + X2) * X1)) * X1)))).-step(delete(rule(200, (X1 + (((X2 * X1) + X3) * X1)) = ((((X1 + X2) * X1) + X3) * X1)))).-step(delete(rule(202, ((X1 + ((X1 * X1) + X2)) * (X1 * X1)) = ((X1 + ((X2 + X1) * X1)) * X1)))).-step(hard(((X1 + X3) * (X2 + X2)) = ((X3 + X1) * (X2 + X2)))).-step(hard(((X1 + X1) * (X2 + X3)) = ((X1 + X1) * (X3 + X2)))).-step(add(rule(208, (X2 + (X2 + (X1 * (X2 * (X2 + X2))))) = ((X1 + X2) * (X2 * (X2 + X2)))))).-step(add(rule(209, (X1 * ((X1 + X1) * (X1 + X1))) = (X1 + (X1 + (X1 + X1)))))).-step(add(rule(210, (X3 + (X4 + (X2 + (-(X3 + X4) + X1)))) = (X1 + X2)))).-step(add(rule(211, (X3 + (X4 + (X1 + (X2 + -(X3 + X4))))) = (X1 + X2)))).-step(add(rule(212, (X1 * ((X1 * (X1 + X1)) + X2)) = (X1 + (X1 + (X1 * X2)))))).-step(add(rule(213, (X1 * (X2 + (X1 * (X1 + X1)))) = (X1 + (X1 + (X1 * X2)))))).-step(add(rule(214, ((X2 + (X3 + (X1 * X1))) * X1) = (X1 + ((X2 + X3) * X1))))).-step(add(rule(215, (X2 + (X2 + (X1 * (X2 + X2)))) = ((X1 + (X2 * X2)) * (X2 + X2))))).-step(add(rule(216, ((X1 + X1) * (X2 + X2)) = (X1 * ((X1 + X1) * ((X1 + X1) * X2)))))).-step(add(rule(217, ((X1 + X1) * ((X1 + X1) * (X2 + X2))) = (X1 * ((X1 + X1) * X2))))).-step(add(rule(218, (X1 * (X1 * ((X1 * X3) + X2))) = (X1 * ((X1 * X2) + X3))))).-step(hard(((X1 + X2) * (X3 + X3)) = ((X1 + (X2 + (X1 + X2))) * X3))).-step(hard(((X1 + (X1 + (X2 + X2))) * X3) = ((X2 + X1) * (X3 + X3)))).-step(hard(((X1 + X1) * (X2 + X3)) = (X1 * (X2 + (X3 + (X2 + X3)))))).-step(hard((X1 * (X2 + (X2 + (X3 + X3)))) = ((X1 + X1) * (X3 + X2)))).-step(add(rule(219, ((X1 + (X2 * (X2 + X2))) * X2) = (X2 + (X2 + (X1 * X2)))))).-step(add(rule(220, -(X2 + (-X1 + X3)) = (X1 + -(X2 + X3))))).-step(add(rule(221, -((X1 * -X2) + X3) = ((X1 * X2) + -X3)))).-step(add(rule(222, ((? + (-? + X2)) * (X3 + X3)) = ((X2 + X2) * X3)))).-step(add(rule(223, ((X1 + (-X1 + X2)) * (X3 + X3)) = ((? + (-? + X2)) * (X3 + X3))))).-step(add(rule(224, ((X1 + X1) * (? + (-? + X3))) = (X1 * (X3 + X3))))).-step(add(rule(225, ((X1 + X1) * (X2 + (-X2 + X3))) = ((X1 + X1) * (? + (-? + X3)))))).-step(add(rule(226, ((-X1 + X2) * -X3) = ((X1 + -X2) * X3)))).-step(add(rule(227, ((X1 * X2) + -(X3 + (X1 * X2))) = -X3))).-step(add(rule(228, (((X1 + X1) * X2) + X3) = (X3 + (X1 * (X2 + X2)))))).-step(add(rule(229, ((X1 * (X2 + X2)) + X3) = (X3 + ((X1 + X1) * X2))))).-step(add(rule(230, (X1 * (X2 * (X1 * (X2 * (X1 * (X2 * X3)))))) = (X1 * (X2 * X3))))).-step(add(rule(231, ((X1 * (X2 * X3)) + ((X4 * X3) + X5)) = ((((X1 * X2) + X4) * X3) + X5)))).-step(add(rule(232, ((X1 * (X2 * (X3 * X5))) + (X4 * X5)) = (((X1 * (X2 * X3)) + X4) * X5)))).-step(add(rule(233, ((X1 * (X2 * X5)) + (X3 * (X4 * X5))) = (((X1 * X2) + (X3 * X4)) * X5)))).-step(add(rule(234, ((X1 * (X2 * X3)) + (X4 + (X5 * X3))) = (X4 + (((X1 * X2) + X5) * X3))))).-step(add(rule(235, ((((X1 + X1) * X2) + X3) * X4) = ((X1 * (X2 * (X4 + X4))) + (X3 * X4))))).-step(add(rule(236, ((X1 + ((X1 + X1) * X2)) * X3) = (X1 * (X3 + (X2 * (X3 + X3))))))).-step(add(rule(237, (((X1 * (X2 + X2)) + X3) * X4) = ((X1 * (X2 * (X4 + X4))) + (X3 * X4))))).-step(add(rule(238, (((X1 * X2) + (X3 + X3)) * X4) = ((X1 * (X2 * X4)) + (X3 * (X4 + X4)))))).-step(add(rule(239, (((X1 * X1) + (X2 + X2)) * X1) = (X1 + (X2 * (X1 + X1)))))).-step(add(rule(240, ((X1 + X1) * ((X2 + (X1 * X1)) * X3)) = ((X1 + X1) * (X3 + (X2 * X3)))))).-step(add(rule(241, ((X2 + ((X1 * X1) + X2)) * X1) = (X1 + (X2 * (X1 + X1)))))).-step(add(rule(242, (((X1 * X2) + X3) * (X2 * (X2 * X4))) = ((X1 + (X3 * X2)) * (X2 * X4))))).-step(add(rule(243, ((X1 + (X1 * (X2 * -X2))) * (X2 * X3)) = 0))).-step(add(rule(244, (X1 * (X2 + (X2 * (X1 * -X1)))) = 0))).-step(add(rule(245, ((X1 + (X1 * (X2 * -X2))) * (X2 + X2)) = 0))).-step(add(rule(246, (X1 * ((X2 + (X2 * (X1 * -X1))) * X3)) = 0))).-step(add(rule(247, ((X1 + (X1 * (X2 * -X2))) * -X2) = 0))).-step(add(rule(248, (X1 * -(X2 + (X2 * (X1 * -X1)))) = 0))).-step(add(rule(249, (X1 * (-X2 + (X2 * (X1 * X1)))) = 0))).-step(add(rule(250, ((X1 * X2) + ((X3 * (X4 * X2)) + X5)) = (((X1 + (X3 * X4)) * X2) + X5)))).-step(add(rule(251, ((X1 * X5) + (X2 * (X3 * (X4 * X5)))) = ((X1 + (X2 * (X3 * X4))) * X5)))).-step(add(rule(252, ((X1 * X2) + (X3 + (X4 * (X5 * X2)))) = (X3 + ((X1 + (X4 * X5)) * X2))))).-step(add(rule(253, (X1 + ((X2 + (X1 * X3)) * X1)) = ((X2 + (X1 * (X1 + X3))) * X1)))).-step(add(rule(254, ((X1 + (X1 + (X2 * X3))) * X4) = ((X1 * (X4 + X4)) + (X2 * (X3 * X4)))))).-step(add(rule(255, ((X1 + ((X2 + X2) * X3)) * X4) = ((X1 * X4) + (X2 * (X3 * (X4 + X4))))))).-step(add(rule(256, ((X1 + (X2 * (X3 + X3))) * X4) = ((X1 * X4) + (X2 * (X3 * (X4 + X4))))))).-step(add(rule(257, ((X1 + (X2 * X3)) * (X3 * (X3 * X4))) = (((X1 * X3) + X2) * (X3 * X4))))).-step(add(rule(258, (X1 * ((X2 * (X1 * (X2 * (X1 * X2)))) + X3)) = (X1 * (X2 + X3))))).-step(add(rule(259, (X1 * (X2 + (X3 * (X1 * (X3 * (X1 * X3)))))) = (X1 * (X2 + X3))))).-step(add(rule(260, (X2 + ((X1 + X2) * (X2 * -X2))) = (X1 * (X2 * -X2))))).-step(add(rule(261, (X1 * (X2 * -(X3 + X3))) = (X1 * ((X2 + X2) * -X3))))).-step(add(rule(262, (X1 * (X2 + (X3 * X2))) = (X1 * (X1 * ((X1 + (X1 * X3)) * X2)))))).-step(add(rule(263, (X1 * (X2 + (X3 + (X1 * (X1 * X4))))) = (X1 * (X2 + (X3 + X4)))))).-step(add(rule(264, (X1 * ((X2 + (X1 * (X1 * X3))) * X4)) = (X1 * ((X2 + X3) * X4))))).-step(add(rule(265, (X1 * (X2 + (X3 + X3))) = (X1 * (X2 + (X1 * ((X1 + X1) * X3))))))).-step(add(rule(266, (X1 * (X2 + (X1 * (X1 + (X1 * X3))))) = (X1 + (X1 * (X2 + X3)))))).-step(add(rule(267, (X1 * (X2 * -(X3 + X3))) = ((X1 + X1) * (X2 * -X3))))).-step(add(rule(268, ((X1 + (X1 * X2)) * -X3) = (X1 * -(X3 + (X2 * X3)))))).-step(add(rule(269, (X1 + (X2 * (X1 * -X1))) = ((X1 + -X2) * (X1 * X1))))).-step(add(rule(270, ((X1 + X1) * (X1 + X1)) = (X1 * -(X1 + X1))))).-step(add(rule(271, ((X1 + X1) * -(X1 + X1)) = (X1 * (X1 + X1))))).-step(add(rule(272, (X1 + (X1 + (X1 + X1))) = -(X1 + X1)))).-step(add(rule(273, -(X1 + (X1 + X1)) = (X1 + (X1 + X1))))).-step(add(rule(274, (-X1 + (X2 * (X1 * X1))) = ((-X1 + X2) * (X1 * X1))))).-step(add(rule(275, -(X1 + (X1 * (X2 * -X1))) = (X1 * ((X2 + -X1) * X1))))).-step(add(rule(276, (X1 + (X1 * (X2 * -X1))) = (X1 * ((X1 + -X2) * X1))))).-step(add(rule(277, ((X1 + (X1 * -X2)) * X3) = (X1 * (X3 + (X2 * -X3)))))).-step(add(rule(278, (X1 * (X2 + (X2 + X2))) = ((X1 + (X1 + X1)) * -X2)))).-step(add(rule(279, ((X1 + X1) * (X2 + (X2 + X2))) = 0))).-step(interreduce).-step(delete(rule(108, (X1 + ((X2 + (X1 * -X1)) * X1)) = (X2 * X1)))).-step(delete(rule(112, ((X1 + (X1 + (X1 + X1))) * X2) = (X1 * (X2 + (X2 + (X2 + X2))))))).-step(delete(rule(113, ((X1 * X3) + (X2 * (X1 * (X1 * X3)))) = ((X1 + X2) * (X1 * (X1 * X3)))))).-step(delete(rule(114, (X1 * ((X1 + X1) * ((X1 + X1) * (X2 + X2)))) = ((X1 + X1) * X2)))).-step(delete(rule(145, ((X1 + X1) * (X1 + (X1 + (X1 + X1)))) = (X1 * (X1 + X1))))).-step(delete(rule(154, ((X1 * (X2 + X2)) + X3) = (((X1 + X1) * X2) + X3)))).-step(delete(rule(166, ((X1 + X1) * (X2 * ((X2 + X2) * (X2 + X2)))) = (X1 * (X2 + X2))))).-step(add(rule(280, ((X1 + X1) * -(X2 + X2)) = (X1 * (X2 + X2))))).-step(delete(rule(187, ((X2 * X1) + -(X1 + (X2 * X1))) = -X1))).-step(delete(rule(205, ((X1 + X1) * (X2 + (X2 + X2))) = ((X1 + (X1 + X1)) * (X2 + X2))))).-step(add(rule(281, ((X1 + (X1 + X1)) * (X2 + X2)) = 0))).-step(delete(rule(209, (X1 * ((X1 + X1) * (X1 + X1))) = (X1 + (X1 + (X1 + X1)))))).-step(delete(rule(210, (X3 + (X4 + (X2 + (-(X3 + X4) + X1)))) = (X1 + X2)))).-step(delete(rule(212, (X1 * ((X1 * (X1 + X1)) + X2)) = (X1 + (X1 + (X1 * X2)))))).-step(delete(rule(231, ((X1 * (X2 * X3)) + ((X4 * X3) + X5)) = ((((X1 * X2) + X4) * X3) + X5)))).-step(delete(rule(242, (((X1 * X2) + X3) * (X2 * (X2 * X4))) = ((X1 + (X3 * X2)) * (X2 * X4))))).-step(delete(rule(247, ((X1 + (X1 * (X2 * -X2))) * -X2) = 0))).-step(delete(rule(250, ((X1 * X2) + ((X3 * (X4 * X2)) + X5)) = (((X1 + (X3 * X4)) * X2) + X5)))).-step(delete(rule(258, (X1 * ((X2 * (X1 * (X2 * (X1 * X2)))) + X3)) = (X1 * (X2 + X3))))).-step(delete(rule(260, (X2 + ((X1 + X2) * (X2 * -X2))) = (X1 * (X2 * -X2))))).-step(delete(rule(271, ((X1 + X1) * -(X1 + X1)) = (X1 * (X1 + X1))))).-step(delete(rule(275, -(X1 + (X1 * (X2 * -X1))) = (X1 * ((X2 + -X1) * X1))))).-step(add(rule(282, ((X1 + (X1 + X1)) * -(X2 + X2)) = 0))).-step(add(rule(283, ((X1 + X1) * (X2 + X2)) = (X1 * -(X2 + X2))))).-step(add(rule(284, ((X1 + (X1 + X1)) * ((X2 + X2) * X3)) = 0))).-step(add(rule(285, ((X1 + (X1 + X1)) * (X2 * (X3 + X3))) = 0))).-step(add(rule(286, ((X1 + X1) * ((X2 + (X2 + X2)) * X3)) = 0))).-step(add(rule(287, (((X1 + X1) * X2) + (((X1 + X1) * X2) + (((X1 + X1) * X2) + X3))) = X3))).-step(add(rule(288, (((X1 + (X1 + X1)) * X2) + (((X1 + (X1 + X1)) * X2) + X3)) = X3))).-step(add(rule(289, ((X1 + X1) * (X2 + (X2 * (X1 * (X1 + X1))))) = 0))).-step(add(rule(290, ((X1 + (X1 * (X2 * (X2 + X2)))) * (X2 + X2)) = 0))).-step(add(rule(291, ((X1 + X1) * (X2 * (X3 + (X3 + X3)))) = 0))).-step(add(rule(292, (X1 * (X2 + (X2 + X3))) = (X1 * ((X1 * ((X1 + X1) * X2)) + X3))))).-step(add(rule(293, ((X1 + (X1 + X1)) * (X1 * ((X1 + X1) * X2))) = 0))).-step(add(rule(294, ((X1 + (X1 + X1)) * (X1 * -(X1 + X1))) = 0))).-step(add(rule(295, (X1 * (-X2 + (-X2 + X3))) = (X1 * (-(X2 + X2) + X3))))).-step(add(rule(296, (X1 * (X1 * ((X1 + (X1 * X2)) * X3))) = ((X1 + (X1 * X2)) * X3)))).-step(add(rule(297, (((X1 * (X2 * (X3 * X3))) + X4) * X3) = (((X1 * X2) + X4) * X3)))).-step(add(rule(298, (((X1 * (X2 * (X2 + X2))) + X3) * X2) = ((X1 + (X1 + X3)) * X2)))).-step(add(rule(299, (X1 * (-(X2 + X2) + X3)) = (X1 * (X3 + -(X2 + X2)))))).-step(add(rule(300, ((X1 * -(X2 + X2)) + X3) = (X3 + ((X1 + X1) * -X2))))).-step(add(rule(301, (X1 + ((X2 + X2) * -X3)) = (X1 + (X2 * -(X3 + X3)))))).-step(add(rule(302, -(X3 + ((X1 + X1) * X2)) = -(X3 + (X1 * (X2 + X2)))))).-step(add(rule(303, (((X1 + X1) * -X2) + X3) = (X3 + (X1 * -(X2 + X2)))))).-step(add(rule(304, (((X1 * (X2 * X2)) + X3) * (X2 * X4)) = ((X1 + X3) * (X2 * X4))))).-step(add(rule(305, ((X1 + (X2 * (X3 * X3))) * (X3 * X4)) = ((X1 + X2) * (X3 * X4))))).-step(add(rule(306, (X1 * ((X1 * -X1) + X2)) = (-X1 + (X1 * X2))))).-step(add(rule(307, (X1 + (-X1 + (X1 * X2))) = (X1 * X2)))).-step(add(rule(308, (X1 * (X2 + (X1 * -X1))) = (-X1 + (X1 * X2))))).-step(add(rule(309, (X1 * (X2 * (X3 * (X4 + X4)))) = ((X1 + X1) * (X2 * (X3 * X4)))))).-step(add(rule(310, (X1 * (X2 * (X3 * (X4 + X4)))) = (X1 * ((X2 + X2) * (X3 * X4)))))).-step(add(rule(311, ((X1 + X1) * (X2 * (X3 + X3))) = (X1 * (X2 * -(X3 + X3)))))).-step(add(rule(312, ((X1 + X1) * ((X2 + X2) * X3)) = (X1 * (X2 * -(X3 + X3)))))).-step(add(rule(313, ((X1 * (X2 + X2)) + ((X3 + -X1) * X2)) = ((X1 + X3) * X2)))).-step(add(rule(314, ((X1 * (X2 + X2)) + ((-X1 + X3) * X2)) = ((X3 + X1) * X2)))).-step(add(rule(315, ((X1 + (X1 + X1)) * (X2 * X3)) = (X1 * ((X2 + (X2 + X2)) * X3))))).-step(add(rule(316, (X1 * (X2 * (X3 + (X3 + X3)))) = (X1 * ((X2 + (X2 + X2)) * X3))))).-step(add(rule(317, (((X1 + X1) * X2) + (X1 * (X3 + -X2))) = (X1 * (X2 + X3))))).-step(add(rule(318, (((X1 + X1) * X2) + (X1 * (-X2 + X3))) = (X1 * (X3 + X2))))).-step(add(rule(319, (X1 * (X2 + (X2 * (X1 * X1)))) = ((X1 + X1) * X2)))).-step(add(rule(320, (X1 + (X1 * (X2 + ((X1 * -X1) + X3)))) = (X1 * (X3 + X2))))).-step(hard(((X1 + (X1 + (X2 + X2))) * X3) = ((X1 + (X2 + (X1 + X2))) * X3))).-step(hard((X1 * (X2 + (X2 + (X3 + X3)))) = (X1 * (X2 + (X3 + (X2 + X3)))))).-step(add(rule(321, (X1 * (((X2 + X2) * X3) + X4)) = (X1 * (X4 + ((X2 + X2) * X3)))))).-step(add(rule(322, (X1 * (((X2 + X2) * X3) + X4)) = (X1 * (X4 + (X2 * (X3 + X3))))))).-step(add(rule(323, (X1 * ((X2 * (X3 + X3)) + X4)) = (X1 * (X4 + ((X2 + X2) * X3)))))).-step(add(rule(324, (X1 + (X1 * (X2 * (X3 + X3)))) = (X1 + (X1 * ((X2 + X2) * X3)))))).-step(hard((X1 * (X2 * (X3 + (X4 + X4)))) = (X1 * (X2 * (X4 + (X4 + X3)))))).-step(hard((X1 * ((X2 + (X4 + X4)) * X3)) = (X1 * ((X4 + (X4 + X2)) * X3)))).-step(add(rule(325, ((X1 * (X1 * (X2 + X1))) + X3) = (X1 + ((X1 * (X1 * X2)) + X3))))).-step(add(rule(326, (X1 + (X2 * (X2 * (X2 + X3)))) = (X2 + ((X2 * (X2 * X3)) + X1))))).-step(add(rule(327, (X1 + (X2 + (X1 * (X1 * X3)))) = (X2 + (X1 * (X1 * (X3 + X1))))))).-step(hard((X1 + (X1 * ((X1 + X1) * X2))) = (X1 * (X1 * (X2 + (X1 + X2)))))).-step(add(rule(328, ((X1 * ((X2 + X1) * X1)) + X3) = (X1 + ((X1 * (X2 * X1)) + X3))))).-step(add(rule(329, (X1 + (X2 * ((X2 + X3) * X2))) = (X2 + ((X2 * (X3 * X2)) + X1))))).-step(add(rule(330, (X1 + (X2 + (X1 * (X3 * X1)))) = (X2 + (X1 * ((X3 + X1) * X1)))))).-step(hard((X1 + (X1 * (X2 * (X1 + X1)))) = (X1 * ((X2 + (X1 + X2)) * X1)))).-step(add(rule(331, (((X1 * (X2 + X2)) + X3) * X4) = ((X3 + ((X1 + X1) * X2)) * X4)))).-step(add(rule(332, ((((X1 + X1) * X2) + X3) * X4) = ((X3 + (X1 * (X2 + X2))) * X4)))).-step(add(rule(333, ((X1 + (X1 * X2)) * (X2 * X3)) = (X1 * (X2 * (X3 + (X2 * X3))))))).-step(add(rule(334, ((X1 + X1) * (X2 + (X1 * ((X1 + X1) * X2)))) = 0))).-step(add(rule(335, (X1 * (X1 * ((X1 + X2) * X2))) = (X1 * ((X2 + X1) * (X2 * X2)))))).-step(add(rule(336, (X1 * (X2 + (X1 * (X3 * X2)))) = (X1 * (X1 * ((X3 + X1) * X2)))))).-step(add(rule(337, (X1 * ((X1 + X2) * (X1 * X2))) = (X1 * (X2 * ((X2 + X1) * X2)))))).-step(add(rule(338, (X1 * (X2 + (X3 * (X1 * X2)))) = (X1 * ((X3 + X1) * (X1 * X2)))))).-step(add(rule(339, (X1 * -(X2 + (X1 * (X1 * -X2)))) = 0))).-step(add(rule(340, ((X1 + (X1 * (X2 * X3))) * X3) = (X1 * ((X3 + X2) * (X3 * X3)))))).-step(add(rule(341, ((X1 + (X1 * (X2 * -X2))) * X2) = 0))).-step(add(rule(342, ((X1 + (X1 * (X2 * -X2))) * -X2) = 0))).-step(add(rule(343, ((X1 + (X1 * (X2 * X3))) * X2) = (X1 * (X2 * ((X2 + X3) * X2)))))).-step(add(rule(344, (X1 * -((X1 * X1) + X2)) = -(X1 + (X1 * X2))))).-step(add(rule(345, (((X1 * X1) + X2) * -X1) = -(X1 + (X2 * X1))))).-step(add(rule(346, ((X1 * X2) + ((X3 + X1) * X4)) = ((X1 * (X4 + X2)) + (X3 * X4))))).-step(hard((X1 * (X2 + (X3 + X2))) = (X1 * (X3 + (X2 + X2))))).-step(hard((X1 * (X2 + (X3 + X2))) = (X1 * (X2 + (X2 + X3))))).-step(add(rule(347, ((X1 * -X2) + ((X3 + X1) * X2)) = (X3 * X2)))).-step(add(rule(348, ((X1 * X2) + ((X3 + X1) * X4)) = ((X3 * X4) + (X1 * (X2 + X4)))))).-step(add(rule(349, (X1 * (X2 + -(X3 + X2))) = (X1 * -X3)))).-step(add(rule(350, ((X1 + -(X3 + X1)) * X2) = (X3 * -X2)))).-step(add(rule(351, (((X1 * X2) + (X4 + X1)) * X3) = ((X4 + (X1 + (X1 * X2))) * X3)))).-step(interreduce).-step(delete(rule(103, ((X1 + (X1 + X1)) * (X1 * X1)) = (X1 + (X1 + X1))))).-step(delete(rule(153, (((X1 + X1) * -X2) + X3) = ((X1 * -(X2 + X2)) + X3)))).-step(delete(rule(168, (X1 * (((X2 + X2) * X3) + X4)) = (X1 * ((X2 * (X3 + X3)) + X4))))).-step(delete(rule(171, (X1 + (X2 + (X1 * (X1 * X3)))) = (X2 + (X1 * (X1 * (X1 + X3))))))).-step(delete(rule(174, (X1 + (X2 + (X1 * (X3 * X1)))) = (X2 + (X1 * ((X1 + X3) * X1)))))).-step(delete(rule(180, (X1 * (X2 + (X1 * (X3 * X2)))) = (X1 * (X1 * ((X1 + X3) * X2)))))).-step(delete(rule(181, (X1 * (X2 + (X3 * (X1 * X2)))) = (X1 * ((X1 + X3) * (X1 * X2)))))).-step(delete(rule(189, ((X1 * X2) + (X3 * (X2 + X4))) = ((X3 * X4) + ((X1 + X3) * X2))))).-step(delete(rule(216, ((X1 + X1) * (X2 + X2)) = (X1 * ((X1 + X1) * ((X1 + X1) * X2)))))).-step(add(rule(352, (X1 * -(X2 + X2)) = (X1 * ((X1 + X1) * ((X1 + X1) * X2)))))).-step(delete(rule(217, ((X1 + X1) * ((X1 + X1) * (X2 + X2))) = (X1 * ((X1 + X1) * X2))))).-step(delete(rule(262, (X1 * (X2 + (X3 * X2))) = (X1 * (X1 * ((X1 + (X1 * X3)) * X2)))))).-step(delete(rule(270, ((X1 + X1) * (X1 + X1)) = (X1 * -(X1 + X1))))).-step(delete(rule(288, (((X1 + (X1 + X1)) * X2) + (((X1 + (X1 + X1)) * X2) + X3)) = X3))).-step(delete(rule(293, ((X1 + (X1 + X1)) * (X1 * ((X1 + X1) * X2))) = 0))).-step(delete(rule(294, ((X1 + (X1 + X1)) * (X1 * -(X1 + X1))) = 0))).-step(delete(rule(304, (((X1 * (X2 * X2)) + X3) * (X2 * X4)) = ((X1 + X3) * (X2 * X4))))).-step(delete(rule(306, (X1 * ((X1 * -X1) + X2)) = (-X1 + (X1 * X2))))).-step(delete(rule(341, ((X1 + (X1 * (X2 * -X2))) * X2) = 0))).-step(add(rule(353, (X1 * ((X1 + X1) * ((X1 + X1) * X2))) = ((X1 + X1) * -X2)))).-step(add(rule(354, (X1 + (X1 + (X1 * (X2 + X2)))) = ((X1 + X1) * (X2 + (X1 * X1)))))).-step(add(rule(355, (X1 + (X1 * ((X1 * X3) + X2))) = (X1 * (X2 + (X1 * (X3 + X1))))))).-step(add(rule(356, (X1 * (X2 + (X1 * (X2 + X1)))) = (X1 + ((X1 + (X1 * X1)) * X2))))).-step(add(rule(357, (X1 + (X1 * ((X3 * X1) + X2))) = (X1 * (X2 + ((X3 + X1) * X1)))))).-step(add(rule(358, (((X1 * -X1) + X2) * -X1) = (X1 + (X2 * -X1))))).-step(add(rule(359, ((X1 + (X2 * -X2)) * X2) = (-X2 + (X1 * X2))))).-step(hard((X1 + ((X2 * (X1 * X1)) + X3)) = (X3 + ((X2 + X1) * (X1 * X1))))).-step(add(rule(360, (X1 + ((X2 + X3) * (X2 * X2))) = (X2 + (X1 + (X3 * (X2 * X2))))))).-step(hard((X1 + ((X2 + X3) * (X3 * X3))) = (X1 + ((X3 + X2) * (X3 * X3))))).-step(add(rule(361, (X2 + (((X3 * X2) + X1) * X2)) = ((X1 + ((X2 + X3) * X2)) * X2)))).-step(add(rule(362, ((X1 + ((X2 + X1) * X2)) * X2) = (X2 + (X1 * (X2 + (X2 * X2))))))).-step(add(rule(363, ((X1 + ((X1 * X1) + X2)) * (X1 * X1)) = ((X1 + ((X1 + X2) * X1)) * X1)))).-step(add(rule(364, ((X2 + (X1 + (X1 * X1))) * (X1 * X1)) = ((X1 + ((X1 + X2) * X1)) * X1)))).-step(add(rule(365, ((X1 + (X1 * X3)) * (X2 + X2)) = ((X1 + X1) * (X2 + (X3 * X2)))))).-step(add(rule(366, (X2 + (((X2 * X3) + X1) * X2)) = ((X1 + (X2 * (X2 + X3))) * X2)))).-step(add(rule(367, ((X1 + (X1 + (X1 + X2))) * (X3 + X3)) = (X2 * (X3 + X3))))).-step(add(rule(368, ((X1 + ((X2 * X2) + X3)) * (X2 * X2)) = ((X2 + ((X1 + X3) * X2)) * X2)))).-step(add(rule(369, (X1 * ((X2 * (X3 + X3)) + X4)) = (X1 * (((X2 + X2) * X3) + X4))))).-step(hard((X1 + X2) = (X3 + (X4 + (X1 + (X2 + -(X4 + X3))))))).-step(add(rule(370, ((X3 + ((X1 * X1) + X2)) * X1) = (X1 + ((X2 + X3) * X1))))).-step(add(rule(371, (((X1 * (X1 + X1)) + X2) * X1) = (X1 + (X1 + (X2 * X1)))))).-step(add(rule(372, (X1 * (X2 + (X3 + (X3 * (X1 * -X1))))) = (X1 * X2)))).-step(add(rule(373, ((X1 + X1) * ((X2 + X2) * -X3)) = (X1 * ((X2 + X2) * X3))))).-step(add(rule(374, ((X1 + X1) * (-(X2 + X2) + X3)) = ((X1 + X1) * (X2 + X3))))).-step(add(rule(375, ((X1 + X1) * (X2 + -(X3 + X3))) = ((X1 + X1) * (X2 + X3))))).-step(add(rule(376, ((X1 + X1) * (X2 * -(X3 + X3))) = (X1 * (X2 * (X3 + X3)))))).-step(add(rule(377, ((X1 + (X1 * (X2 * (X2 + X2)))) * ((X2 + X2) * X3)) = 0))).-step(add(rule(378, ((X1 + (X1 + X1)) * (X2 + (X3 + (X2 + X3)))) = 0))).-step(add(rule(379, ((X1 + (X1 + X1)) * (X2 + (X2 + (X3 + X3)))) = 0))).-step(add(rule(380, (X1 * (-X2 + (X1 * ((X1 + X1) * X2)))) = (X1 * X2)))).-step(add(rule(381, ((X1 + (X1 + X1)) * -X2) = ((X1 + (X1 + X1)) * X2)))).-step(add(rule(382, ((-X1 + (X1 * (X2 * (X2 + X2)))) * X2) = (X1 * X2)))).-step(add(rule(383, (X1 * ((X1 * (X1 + X1)) + X2)) = (X1 + (X1 + (X1 * X2)))))).-step(hard((((X1 * X1) + (X2 + X1)) * X1) = (X1 + ((X2 + X1) * X1)))).-step(hard(((X1 + (-X1 + (X3 + X1))) * X2) = ((X3 + X1) * X2))).-step(add(rule(384, (X2 + (-(X2 + (X3 * X2)) + ((X1 + (X3 + (X1 * X3))) * X2))) = (X1 * (X2 + (X3 * X2)))))).-step(add(rule(385, (X2 + (X2 + (X2 + (X2 + (X2 + (X2 + ((X1 + (X1 + X1)) * X2))))))) = (X1 * (X2 + (X2 + X2)))))).-step(add(rule(386, ((X2 * -X3) + ((X2 + (X2 + (X1 * X2))) * X3)) = ((X2 + (X1 * X2)) * X3)))).-step(add(rule(387, (((X1 + X1) * X2) + X3) = (? + (? + (X3 + (-(? + ?) + (X1 * (X2 + X2))))))))).-step(add(rule(388, (X4 + (X5 + (X3 + (-(X4 + X5) + (X1 * (X2 + X2)))))) = (? + (? + (X3 + (-(? + ?) + (X1 * (X2 + X2))))))))).-step(add(rule(389, (((X1 + X1) * X2) + X3) = ((X1 * (X2 + X2)) + X3)))).-step(add(rule(390, ((X1 * (X2 + X2)) + X3) = (? + (? + (X3 + (-(? + ?) + ((X1 + X1) * X2)))))))).-step(add(rule(391, (X4 + (X5 + (X3 + (-(X4 + X5) + ((X1 + X1) * X2))))) = (? + (? + (X3 + (-(? + ?) + ((X1 + X1) * X2)))))))).-step(add(rule(392, (X1 * (X2 * (X3 + (X3 * (X1 * -X1))))) = 0))).-step(add(rule(393, (X1 * (X2 * (X3 + (X1 * (X1 * -X3))))) = 0))).-step(add(rule(394, ((X1 + (X1 + X1)) * (X2 * -(X3 + X3))) = 0))).-step(add(rule(395, ((X1 + (X1 * (X2 * (X2 + X2)))) * -(X2 + X2)) = 0))).-step(add(rule(396, ((X3 * -X2) + ((X3 + X1) * X2)) = (X1 * X2)))).-step(add(rule(397, ((X1 + X1) * ((X1 + X1) * X2)) = (X1 * ((X1 + X1) * -X2))))).-step(add(rule(398, ((X1 + X1) * (X2 + (X2 * (X1 * -X1)))) = 0))).-step(add(rule(399, (X1 * (X2 * (X3 + (X1 * (X2 * (X1 * X2)))))) = (X1 * (X2 + (X2 * X3)))))).-step(add(rule(400, (X1 + (X2 + (X3 * ((X1 + X2) * (X1 + X2))))) = ((X1 + (X2 + X3)) * ((X1 + X2) * (X1 + X2)))))).-step(add(rule(401, ((X1 + (X2 + (X1 + X2))) * ((X1 + X2) * (X1 + X2))) = (X1 + (X2 + (X1 + X2)))))).-step(add(rule(402, ((X1 * X2) + (X3 * (X1 * (X2 * (X1 * X2))))) = (((X1 * X2) + X3) * (X1 * (X2 * (X1 * X2))))))).-step(add(rule(403, (X1 * ((X1 + (X2 * X1)) * (X2 * (X1 * X2)))) = (X1 * (X2 + (X1 * (X2 * (X1 * X2)))))))).-step(add(rule(404, ((X1 + (X1 * (X2 * -X2))) * (X3 * X2)) = 0))).-step(add(rule(405, (X1 * (X3 * (X3 * (X2 * X3)))) = (X1 * (X2 * X3))))).-step(add(rule(406, ((X3 * X4) + (X1 * (X2 * (X3 * (X3 * X4))))) = (((X1 * X2) + X3) * (X3 * (X3 * X4)))))).-step(add(rule(407, ((X2 + -X1) * (X3 + X3)) = ((X2 + (-(X1 + X1) + X2)) * X3)))).-step(add(rule(408, ((X1 + X1) * (X3 + -X2)) = (X1 * (X3 + (-(X2 + X2) + X3)))))).-step(add(rule(409, ((X1 + (((X2 * -X2) + X1) * (X2 * -X2))) * (X2 * -X2)) = (X2 * -X2)))).-step(add(rule(410, (X1 * (X2 + (X1 * ((X1 + X1) * -X2)))) = (X1 * -X2)))).-step(add(rule(411, ((X1 + (X1 + X2)) * -(X3 + X3)) = ((X1 + -X2) * (X3 + X3))))).-step(add(rule(412, ((X1 + X1) * ((X2 + X2) * X3)) = (X1 * ((X2 + X2) * -X3))))).-step(add(rule(413, ((X1 + X1) * (X2 + (X2 + X3))) = ((X1 + X1) * (X3 + -X2))))).-step(add(rule(414, ((X1 + X1) * (X2 + (X1 * ((X1 + X1) * X3)))) = ((X1 + X1) * (X2 + -X3))))).-step(add(rule(415, ((X2 + (X2 * (X3 * -X3))) * X3) = 0))).-step(add(rule(416, ((X2 + (X2 + X1)) * (X3 + X3)) = ((X1 + -X2) * (X3 + X3))))).-step(add(rule(417, ((X1 + X1) * (X2 + (X3 + X3))) = ((X1 + X1) * (X2 + -X3))))).-step(add(rule(418, ((X1 + (X2 * -(X2 + X2))) * X2) = ((X1 * X2) + -(X2 + X2))))).-step(add(rule(419, ((X1 + (X2 * (X2 * -X1))) * -X2) = 0))).-step(add(rule(420, (X1 * (X1 * (X2 * X1))) = (X2 * X1)))).-step(add(rule(421, (X2 * (X2 * (X1 * -X2))) = (X1 * -X2)))).-step(add(rule(422, ((X1 + (X2 * (X2 * -X1))) * X2) = 0))).-step(add(rule(423, ((X1 + X2) * ((X3 + X3) * X4)) = ((X1 + (X2 + (X1 + X2))) * (X3 * X4))))).-step(add(rule(424, ((X1 + (X2 + (X1 + X2))) * (X3 + (X3 + X3))) = 0))).-step(add(rule(425, ((X1 + X2) * ((X3 + X3) * X4)) = ((X1 + (X1 + (X2 + X2))) * (X3 * X4))))).-step(hard(((X1 + X2) * ((X3 + X3) * X4)) = ((X2 + X1) * (X3 * (X4 + X4))))).-step(add(rule(426, ((X1 + -(X2 + X2)) * (X3 + X3)) = ((X1 + X2) * (X3 + X3))))).-step(add(rule(427, (X1 * ((X2 + X2) * (X3 + (X2 * X2)))) = ((X1 + X1) * (X2 + (X2 * X3)))))).-step(add(rule(428, ((X1 + X1) * ((X2 + X3) * X4)) = (X1 * ((X2 + (X3 + (X2 + X3))) * X4))))).-step(add(rule(429, (X1 * (((X2 + X2) * X3) + X4)) = (((X1 + X1) * (X2 * X3)) + (X1 * X4))))).-step(add(rule(430, (X1 + ((X1 + X1) * (X2 * X3))) = (X1 + (X1 * ((X2 + X2) * X3)))))).-step(add(rule(431, (X1 * (X2 + ((X3 + X3) * X4))) = ((X1 * X2) + ((X1 + X1) * (X3 * X4)))))).-step(add(rule(432, (X1 * (X2 + (X1 * -(X1 + X1)))) = ((X1 * X2) + -(X1 + X1))))).-step(add(rule(433, ((X1 + X1) * ((X2 + X3) * X4)) = (X1 * ((X2 + (X2 + (X3 + X3))) * X4))))).-step(hard(((X1 + X1) * ((X2 + X3) * X4)) = (X1 * ((X3 + X2) * (X4 + X4))))).-step(add(rule(434, (X1 * ((X2 + X2) * (X3 + X4))) = (X1 * (X2 * (X3 + (X4 + (X3 + X4)))))))).-step(add(rule(435, (X1 * ((X2 + X2) * (X3 + X4))) = (X1 * (X2 * (X3 + (X3 + (X4 + X4)))))))).-step(hard((X1 * ((X2 + X2) * (X3 + X4))) = (X1 * ((X2 + X2) * (X4 + X3))))).-step(add(rule(436, (X1 * ((X2 + X3) * (X4 + X4))) = (X1 * ((X2 + (X3 + (X2 + X3))) * X4))))).-step(add(rule(437, (X1 * ((X2 + X3) * (X4 + X4))) = (X1 * ((X2 + (X2 + (X3 + X3))) * X4))))).-step(interreduce).-step(delete(rule(194, (X1 + (X1 + (X1 * (X2 + X2)))) = ((X1 + X1) * ((X1 * X1) + X2))))).-step(delete(rule(207, ((X1 + (X2 + (X1 * X1))) * (X1 * X1)) = ((X1 + ((X1 + X2) * X1)) * X1)))).-step(delete(rule(240, ((X1 + X1) * ((X2 + (X1 * X1)) * X3)) = ((X1 + X1) * (X3 + (X2 * X3)))))).-step(delete(rule(241, ((X2 + ((X1 * X1) + X2)) * X1) = (X1 + (X2 * (X1 + X1)))))).-step(delete(rule(245, ((X1 + (X1 * (X2 * -X2))) * (X2 + X2)) = 0))).-step(delete(rule(278, (X1 * (X2 + (X2 + X2))) = ((X1 + (X1 + X1)) * -X2)))).-step(delete(rule(279, ((X1 + X1) * (X2 + (X2 + X2))) = 0))).-step(delete(rule(281, ((X1 + (X1 + X1)) * (X2 + X2)) = 0))).-step(delete(rule(282, ((X1 + (X1 + X1)) * -(X2 + X2)) = 0))).-step(delete(rule(290, ((X1 + (X1 * (X2 * (X2 + X2)))) * (X2 + X2)) = 0))).-step(delete(rule(312, ((X1 + X1) * ((X2 + X2) * X3)) = (X1 * (X2 * -(X3 + X3)))))).-step(delete(rule(334, ((X1 + X1) * (X2 + (X1 * ((X1 + X1) * X2)))) = 0))).-step(delete(rule(352, (X1 * -(X2 + X2)) = (X1 * ((X1 + X1) * ((X1 + X1) * X2)))))).-step(delete(rule(353, (X1 * ((X1 + X1) * ((X1 + X1) * X2))) = ((X1 + X1) * -X2)))).-step(delete(rule(363, ((X1 + ((X1 * X1) + X2)) * (X1 * X1)) = ((X1 + ((X1 + X2) * X1)) * X1)))).-step(delete(rule(367, ((X1 + (X1 + (X1 + X2))) * (X3 + X3)) = (X2 * (X3 + X3))))).-step(delete(rule(373, ((X1 + X1) * ((X2 + X2) * -X3)) = (X1 * ((X2 + X2) * X3))))).-step(delete(rule(374, ((X1 + X1) * (-(X2 + X2) + X3)) = ((X1 + X1) * (X2 + X3))))).-step(delete(rule(378, ((X1 + (X1 + X1)) * (X2 + (X3 + (X2 + X3)))) = 0))).-step(delete(rule(386, ((X2 * -X3) + ((X2 + (X2 + (X1 * X2))) * X3)) = ((X2 + (X1 * X2)) * X3)))).-step(delete(rule(397, ((X1 + X1) * ((X1 + X1) * X2)) = (X1 * ((X1 + X1) * -X2))))).-step(delete(rule(401, ((X1 + (X2 + (X1 + X2))) * ((X1 + X2) * (X1 + X2))) = (X1 + (X2 + (X1 + X2)))))).-step(add(rule(438, ((X1 + X2) * ((X1 + X2) * (X1 + (X1 + (X2 + X2))))) = (X1 + (X2 + (X1 + X2)))))).-step(delete(rule(404, ((X1 + (X1 * (X2 * -X2))) * (X3 * X2)) = 0))).-step(delete(rule(405, (X1 * (X3 * (X3 * (X2 * X3)))) = (X1 * (X2 * X3))))).-step(delete(rule(413, ((X1 + X1) * (X2 + (X2 + X3))) = ((X1 + X1) * (X3 + -X2))))).-step(delete(rule(423, ((X1 + X2) * ((X3 + X3) * X4)) = ((X1 + (X2 + (X1 + X2))) * (X3 * X4))))).-step(delete(rule(428, ((X1 + X1) * ((X2 + X3) * X4)) = (X1 * ((X2 + (X3 + (X2 + X3))) * X4))))).-step(delete(rule(434, (X1 * ((X2 + X2) * (X3 + X4))) = (X1 * (X2 * (X3 + (X4 + (X3 + X4)))))))).-step(delete(rule(436, (X1 * ((X2 + X3) * (X4 + X4))) = (X1 * ((X2 + (X3 + (X2 + X3))) * X4))))).-step(hard((X1 * ((X2 + X3) * (X4 + X4))) = (X1 * ((X3 + X2) * (X4 + X4))))).-step(add(rule(439, ((X1 * X2) + (X3 * -(X2 + X2))) = ((X1 + -(X3 + X3)) * X2)))).-step(add(rule(440, ((X1 + (X2 + X2)) * X3) = ((X1 * X3) + (X2 * (X3 + X3)))))).-step(hard((((X1 + X1) * X2) + (X1 * -(X2 + X2))) = 0)).-step(add(rule(441, ((X1 + X2) * (X3 + (X4 * X3))) = ((X1 + (X2 + ((X1 + X2) * X4))) * X3)))).-step(add(rule(442, ((X1 + ((X1 * X2) + X3)) * X4) = ((X1 * (X4 + (X2 * X4))) + (X3 * X4))))).-step(add(rule(443, ((X1 + (X2 + (X2 * X3))) * X4) = ((X1 * X4) + (X2 * (X4 + (X3 * X4))))))).-step(add(rule(444, ((X1 + X1) * (X2 + (X3 * X2))) = ((X1 + (X1 + (X1 * (X3 + X3)))) * X2)))).-step(add(rule(445, (X1 * (X2 + ((X3 + (X1 * X1)) * X2))) = ((X1 + (X1 + (X1 * X3))) * X2)))).-step(add(rule(446, ((X1 + (X1 * X2)) * (X3 + X4)) = (X1 * (X3 + (X4 + (X2 * (X3 + X4)))))))).-step(add(rule(447, (X1 * (X2 + ((X3 * X2) + X4))) = (((X1 + (X1 * X3)) * X2) + (X1 * X4))))).-step(add(rule(448, (X1 * (-X2 + (X3 * X2))) = ((-X1 + (X1 * X3)) * X2)))).-step(add(rule(449, (X1 + (X1 * (X2 + (X3 * X2)))) = (X1 + ((X1 + (X1 * X3)) * X2))))).-step(add(rule(450, (X1 * ((X2 * X3) + ((X2 * -X3) + X4))) = (X1 * X4)))).-step(add(rule(451, (X1 * (X2 * (X3 * (X1 * X1)))) = (X1 * (X2 * X3))))).-step(add(rule(452, (X1 * (X2 * (X1 * X1))) = (X1 * X2)))).-step(add(rule(453, (X1 * (X2 * (X1 * -X1))) = (X1 * -X2)))).-step(add(rule(454, (X1 * (X2 + (X3 * (X1 * X1)))) = (X1 * (X2 + X3))))).-step(add(rule(455, (X1 * (X2 * (X1 * (X1 + X1)))) = ((X1 + X1) * X2)))).-step(add(rule(456, (X1 * ((X1 + (X2 * X1)) * X1)) = (X1 + (X1 * X2))))).-step(add(rule(457, (X1 * (X2 * (X1 * X2))) = (X1 * (X2 * (X2 * X1)))))).-step(add(rule(458, ((X1 + (X2 * X1)) * X1) = (X1 * (X1 + (X1 * X2)))))).-step(add(rule(459, (X1 * (X2 + (X3 + (X4 * X3)))) = ((X1 * X2) + ((X1 + (X1 * X4)) * X3))))).-step(add(rule(460, (X1 * (X2 + (X3 + X3))) = ((X1 * X2) + ((X1 + X1) * X3))))).-step(add(rule(461, (X1 * ((X1 * X1) + (X2 + X2))) = (X1 + ((X1 + X1) * X2))))).-step(add(rule(462, ((X1 + (X2 + X1)) * (X3 + X3)) = ((X2 + -X1) * (X3 + X3))))).-step(add(rule(463, ((X2 + (X1 + X1)) * (X3 + X3)) = ((X2 + -X1) * (X3 + X3))))).-step(add(rule(464, ((X1 + X1) * (X3 + (X2 * X3))) = (X1 * (X3 + (X3 + ((X2 + X2) * X3))))))).-step(add(rule(465, (X1 * -(X2 + (X1 * (X1 * X3)))) = (X1 * -(X2 + X3))))).-step(add(rule(466, ((X3 * X5) + (X1 + (X2 + (X3 * X4)))) = (X1 + (X2 + (X3 * (X4 + X5))))))).-step(add(rule(467, (X1 + (X2 * (X3 + (X4 + X4)))) = (((X2 + X2) * X4) + (X1 + (X2 * X3)))))).-step(add(rule(468, (X1 + (X2 * (X3 + (X3 + X3)))) = (X1 + ((X2 + (X2 + X2)) * X3))))).-step(add(rule(469, (X1 + (X2 * (X3 + (X3 + X4)))) = ((X2 * X4) + (X1 + ((X2 + X2) * X3)))))).-step(add(rule(470, (X1 + (X2 + (X2 * (X3 + X3)))) = (X2 + (X1 + ((X2 + X2) * X3)))))).-step(hard((X1 * (X2 + (X3 + (X3 + X4)))) = (X1 * (X4 + (X3 + (X3 + X2)))))).-step(add(rule(471, ((X2 * X3) + ((X1 + X2) * (X1 * X1))) = (X1 + (X2 * ((X1 * X1) + X3)))))).-step(add(rule(472, ((X4 * X5) + (X1 + (X2 + (X3 * X5)))) = (X1 + (X2 + ((X3 + X4) * X5)))))).-step(add(rule(473, (X1 + ((X2 + (X3 + X3)) * X4)) = ((X3 * (X4 + X4)) + (X1 + (X2 * X4)))))).-step(add(rule(474, ((X1 + X1) * (X2 + (X3 + X2))) = ((X1 + X1) * (X3 + -X2))))).-step(add(rule(475, (X1 + ((X2 + (X2 + X3)) * X4)) = ((X3 * X4) + (X1 + (X2 * (X4 + X4))))))).-step(hard(((X1 + (X3 + (X3 + X4))) * X2) = ((X4 + (X3 + (X3 + X1))) * X2))).-step(add(rule(476, ((X1 + (X1 + X2)) * (X3 * X4)) = (((X1 * (X3 + X3)) + (X2 * X3)) * X4)))).-step(add(rule(477, (X1 * ((X2 * (X3 + X3)) + (X4 * X3))) = (X1 * ((X2 + (X2 + X4)) * X3))))).-step(add(rule(478, ((X1 * (X2 + X2)) + ((X3 + X4) * X2)) = ((X1 + (X3 + (X1 + X4))) * X2)))).-step(hard(((X1 + (X2 + (X1 + X3))) * X4) = ((X1 + (X1 + (X2 + X3))) * X4))).-step(add(rule(479, ((X1 * (X2 + X2)) + ((X3 * X2) + X4)) = (((X1 + (X1 + X3)) * X2) + X4)))).-step(hard(((X1 + (X1 + (X2 + X4))) * X3) = ((X2 + (X4 + (X1 + X1))) * X3))).-step(add(rule(480, (((X1 * X2) + ((X1 * X2) + X3)) * X4) = ((X1 * (X2 * (X4 + X4))) + (X3 * X4))))).-step(add(rule(481, (((X1 * X2) + ((X1 * X2) + X3)) * X4) = (((X1 * (X2 + X2)) + X3) * X4)))).-step(add(rule(482, ((X1 * (X2 + X2)) + (X3 + (X4 * X2))) = (X3 + ((X1 + (X1 + X4)) * X2))))).-step(hard((X1 + ((X2 + (X2 + X3)) * X4)) = (X1 + ((X3 + (X2 + X2)) * X4)))).-step(hard(((X1 + (X3 + (X3 + X4))) * X2) = ((X3 + (X3 + (X1 + X4))) * X2))).-step(add(rule(483, ((X1 * (X2 + X2)) + ((X3 + X4) * X2)) = ((X4 + (X1 + (X1 + X3))) * X2)))).-step(add(rule(484, ((-? + (X2 + (X2 + ?))) * X3) = (X2 * (X3 + X3))))).-step(add(rule(485, ((-X1 + (X2 + (X2 + X1))) * X3) = ((-? + (X2 + (X2 + ?))) * X3)))).-step(hard(((X1 + (X2 + (X2 + X3))) * X4) = ((X2 + (X2 + (X3 + X1))) * X4))).-step(hard(((X1 + (X2 + (X2 + X3))) * X4) = ((X2 + (X3 + (X2 + X1))) * X4))).-step(add(rule(486, (X1 * (((X2 + X2) * X3) + (X2 * X4))) = (X1 * (X2 * (X3 + (X3 + X4))))))).-step(add(rule(487, (X1 * ((X2 + (X2 + X3)) * X4)) = ((((X1 + X1) * X2) + (X1 * X3)) * X4)))).-step(add(rule(488, ((X1 + (X1 + X1)) * (X2 * X3)) = (X1 * (X2 * (X3 + (X3 + X3))))))).-step(add(rule(489, (((X1 + X1) * X2) + (X1 * (X3 + X4))) = (X1 * (X2 + (X3 + (X2 + X4))))))).-step(hard((X1 * (X2 + (X3 + (X2 + X4)))) = (X1 * (X2 + (X2 + (X3 + X4)))))).-step(add(rule(490, (((X1 + X1) * X2) + ((X1 * X3) + X4)) = ((X1 * (X2 + (X2 + X3))) + X4)))).-step(hard((X1 * (X2 + (X2 + (X3 + X4)))) = (X1 * (X3 + (X4 + (X2 + X2)))))).-step(add(rule(491, ((X1 * (X2 + X2)) + ((X1 * -(X2 + X2)) + X3)) = X3))).-step(add(rule(492, (((X1 + X1) * X2) + (X3 + (X1 * X4))) = (X3 + (X1 * (X2 + (X2 + X4))))))).-step(hard((X1 + (X2 * (X3 + (X3 + X4)))) = (X1 + (X2 * (X4 + (X3 + X3)))))).-step(hard((X1 * (X2 + (X3 + (X3 + X4)))) = (X1 * (X3 + (X3 + (X2 + X4)))))).-step(add(rule(493, (X1 * (X2 + (X2 + ((X3 + X3) * X4)))) = ((X1 + X1) * (X2 + (X3 * X4)))))).-step(add(rule(494, (X1 * (X2 + X2)) = ((X1 + X1) * (X2 + (? + (? + ?))))))).-step(add(rule(495, ((X1 + X1) * (X2 + (X3 + (X3 + X3)))) = ((X1 + X1) * (X2 + (? + (? + ?))))))).-step(add(rule(496, ((X1 + X1) * (X2 + -X3)) = (X1 * (X2 + (X2 + -(X3 + X3))))))).-step(add(rule(497, (X1 * (X1 * (X2 + (X2 + (X1 * X3))))) = (X1 * (((X1 + X1) * X2) + X3))))).-step(add(rule(498, (((X1 + X1) * X2) + (X1 * (X3 + X4))) = (X1 * (X4 + (X2 + (X2 + X3))))))).-step(add(rule(499, (X1 * (-? + (X3 + (X3 + ?)))) = ((X1 + X1) * X3)))).-step(add(rule(500, (X1 * (-X2 + (X3 + (X3 + X2)))) = (X1 * (-? + (X3 + (X3 + ?))))))).-step(hard((X1 * (X2 + (X3 + (X3 + X4)))) = (X1 * (X3 + (X3 + (X4 + X2)))))).-step(hard((X1 * (X2 + (X3 + (X3 + X4)))) = (X1 * (X3 + (X4 + (X3 + X2)))))).-step(add(rule(501, (X1 * (X3 + (X4 + ((X1 * X1) + X2)))) = (X1 + (X1 * (X2 + (X3 + X4))))))).-step(add(rule(502, (X1 * ((X2 + ((X1 * X1) + X3)) * X4)) = ((X1 + (X1 * (X3 + X2))) * X4)))).-step(add(rule(503, (X1 * (X2 + (X3 + (X4 + (X1 * X1))))) = (X1 + (X1 * (X2 + (X3 + X4))))))).-step(add(rule(504, (X1 * ((X2 + (X3 + (X1 * X1))) * X4)) = ((X1 + (X1 * (X2 + X3))) * X4)))).-step(hard(((X1 + (X1 * (X2 + X3))) * X4) = ((X1 + (X1 * (X3 + X2))) * X4))).-step(add(rule(505, ((X1 + (X1 * X2)) * ((X2 + (X1 * X1)) * (X2 + (X1 * X1)))) = (X1 + (X1 * X2))))).-step(interreduce).-step(delete(rule(162, (((? * X2) + ((? * X2) + ((? + X3) * -(X2 + X2)))) * X4) = (X3 * (X2 * -(X4 + X4)))))).-step(delete(rule(163, (((X1 * X2) + ((X1 * X2) + ((X3 + X1) * -(X2 + X2)))) * X4) = (((? * X2) + ((? * X2) + ((? + X3) * -(X2 + X2)))) * X4)))).-step(delete(rule(249, (X1 * (-X2 + (X2 * (X1 * X1)))) = 0))).-step(delete(rule(287, (((X1 + X1) * X2) + (((X1 + X1) * X2) + (((X1 + X1) * X2) + X3))) = X3))).-step(delete(rule(319, (X1 * (X2 + (X2 * (X1 * X1)))) = ((X1 + X1) * X2)))).-step(delete(rule(339, (X1 * -(X2 + (X1 * (X1 * -X2)))) = 0))).-step(delete(rule(364, ((X2 + (X1 + (X1 * X1))) * (X1 * X1)) = ((X1 + ((X1 + X2) * X1)) * X1)))).-step(add(rule(506, ((X2 + (X1 + (X1 * X1))) * (X1 * X1)) = (X1 * (X1 + (X1 * (X1 + X2))))))).-step(delete(rule(368, ((X1 + ((X2 * X2) + X3)) * (X2 * X2)) = ((X2 + ((X1 + X3) * X2)) * X2)))).-step(add(rule(507, ((X1 + ((X2 * X2) + X3)) * (X2 * X2)) = (X2 * (X2 + (X2 * (X1 + X3))))))).-step(delete(rule(408, ((X1 + X1) * (X3 + -X2)) = (X1 * (X3 + (-(X2 + X2) + X3)))))).-step(delete(rule(416, ((X2 + (X2 + X1)) * (X3 + X3)) = ((X1 + -X2) * (X3 + X3))))).-step(delete(rule(456, (X1 * ((X1 + (X2 * X1)) * X1)) = (X1 + (X1 * X2))))).-step(delete(rule(464, ((X1 + X1) * (X3 + (X2 * X3))) = (X1 * (X3 + (X3 + ((X2 + X2) * X3))))))).-step(delete(rule(467, (X1 + (X2 * (X3 + (X4 + X4)))) = (((X2 + X2) * X4) + (X1 + (X2 * X3)))))).-step(delete(rule(473, (X1 + ((X2 + (X3 + X3)) * X4)) = ((X3 * (X4 + X4)) + (X1 + (X2 * X4)))))).-step(delete(rule(480, (((X1 * X2) + ((X1 * X2) + X3)) * X4) = ((X1 * (X2 * (X4 + X4))) + (X3 * X4))))).-step(delete(rule(484, ((-? + (X2 + (X2 + ?))) * X3) = (X2 * (X3 + X3))))).-step(add(rule(508, ((? + (-? + (X2 + X2))) * X3) = (X2 * (X3 + X3))))).-step(delete(rule(485, ((-X1 + (X2 + (X2 + X1))) * X3) = ((-? + (X2 + (X2 + ?))) * X3)))).-step(add(rule(509, ((-X1 + (X2 + (X2 + X1))) * X3) = ((? + (-? + (X2 + X2))) * X3)))).-step(delete(rule(494, (X1 * (X2 + X2)) = ((X1 + X1) * (X2 + (? + (? + ?))))))).-step(add(rule(510, (X1 * (X2 + X2)) = ((X1 + X1) * (? + (? + (? + X2))))))).-step(delete(rule(495, ((X1 + X1) * (X2 + (X3 + (X3 + X3)))) = ((X1 + X1) * (X2 + (? + (? + ?))))))).-step(add(rule(511, ((X1 + X1) * (X2 + (X3 + (X3 + X3)))) = ((X1 + X1) * (? + (? + (? + X2))))))).-step(delete(rule(499, (X1 * (-? + (X3 + (X3 + ?)))) = ((X1 + X1) * X3)))).-step(add(rule(512, (X1 * (? + (-? + (X3 + X3)))) = ((X1 + X1) * X3)))).-step(delete(rule(500, (X1 * (-X2 + (X3 + (X3 + X2)))) = (X1 * (-? + (X3 + (X3 + ?))))))).-step(add(rule(513, (X1 * (-X2 + (X3 + (X3 + X2)))) = (X1 * (? + (-? + (X3 + X3))))))).-step(delete(rule(501, (X1 * (X3 + (X4 + ((X1 * X1) + X2)))) = (X1 + (X1 * (X2 + (X3 + X4))))))).-step(add(rule(514, ((X1 + (X3 * -X1)) * X1) = (X1 * (X1 + (X1 * -X3)))))).-step(add(rule(515, (X1 * (X1 * -X2)) = (X2 * (X1 * -X1))))).-step(add(rule(516, (X1 * (X2 * X2)) = (X2 * (X2 * X1))))).-step(add(rule(517, (X1 * (X1 * X2)) = (X1 * (X2 * X1))))).-step(add(rule(518, (X1 * X2) = (X2 * X1)))).--lemma((X1 + 0) = X1).-lemma((X1 + (-X1 + X2)) = X2).-lemma(-(-X1) = X1).-lemma((X1 + (X2 + X3)) = (X2 + (X1 + X3))).-lemma((X2 + (X1 + -X2)) = X1).-lemma((X1 * (X1 * (X1 * X2))) = (X1 * X2)).-lemma((X1 + (X2 + -(X1 + X2))) = 0).-lemma((X1 * ((X1 * X1) + X2)) = (X1 + (X1 * X2))).-lemma((X1 * 0) = 0).-lemma((X1 * (X2 + (X1 * X1))) = (X1 + (X1 * X2))).-lemma((X2 + -(X1 + X2)) = -X1).-lemma((X1 + (X2 * (X1 * X1))) = ((X1 + X2) * (X1 * X1))).-lemma((X2 + -(X2 + X1)) = -X1).-lemma(-(X1 + -X2) = (X2 + -X1)).-lemma((X1 + (X1 * (X2 * X1))) = (X1 * ((X1 + X2) * X1))).-lemma((0 * X1) = 0).-lemma(((X1 * (X2 * X4)) + (X3 * X4)) = (((X1 * X2) + X3) * X4)).-lemma((X1 * (X3 + (X2 * X3))) = ((X1 + (X1 * X2)) * X3)).-lemma(((X1 + (X1 * X2)) * X3) = (X1 * (X3 + (X2 * X3)))).-lemma(((X1 * X4) + (X2 * (X3 * X4))) = ((X1 + (X2 * X3)) * X4)).-lemma(-(X1 * X2) = (X1 * -X2)).-lemma((-X1 * X2) = (X1 * -X2)).-lemma((X1 * ((X2 + (X1 * X1)) * X3)) = ((X1 + (X1 * X2)) * X3)).-lemma(((X1 + (X2 * X3)) * (X3 * X3)) = (((X1 * X3) + X2) * X3)).-lemma((((X3 * X2) + X1) * (X2 * X2)) = (((X1 * X2) + X3) * X2)).-lemma(((X1 + -X2) * -X3) = ((X2 + -X1) * X3)).-lemma(((X1 + (X1 * X2)) * (X3 * X4)) = (X1 * ((X3 + (X2 * X3)) * X4))).-lemma(((X1 * X2) + (X3 * (X2 + X4))) = ((X3 * X4) + ((X1 + X3) * X2))).-lemma(((X1 + (X1 * (X2 * -X2))) * (X2 * X3)) = 0).-lemma((X1 * ((X2 + (X1 * (X1 * X3))) * X4)) = (X1 * ((X2 + X3) * X4))).-lemma(((X1 + (X2 * (X3 * X3))) * (X3 * X4)) = ((X1 + X2) * (X3 * X4))).-lemma((X1 * (X1 * (X2 * X1))) = (X2 * X1)).-lemma((X1 * (X2 * (X3 * (X1 * X1)))) = (X1 * (X2 * X3))).
− misc/ring_noconn.pl 
@@ -1,977 +0,0 @@-:- module(ring_noconn, [step/1, lemma/1]).-:- discontiguous(step/1).-:- discontiguous(lemma/1).-:- style_check(-singleton).-step(add(rule(1, (X1 + X2) = (X2 + X1)))).-step(add(rule(2, ((X1 + X2) + X3) = (X1 + (X2 + X3))))).-step(add(rule(3, (0 + X1) = X1))).-step(add(rule(4, (X1 + -X1) = 0))).-step(add(rule(5, ((X1 * X2) * X3) = (X1 * (X2 * X3))))).-step(add(rule(6, ((X1 * X2) + (X1 * X3)) = (X1 * (X2 + X3))))).-step(add(rule(7, ((X1 * X3) + (X2 * X3)) = ((X1 + X2) * X3)))).-step(add(rule(8, (X1 * (X1 * X1)) = X1))).-step(add(rule(9, -0 = 0))).-step(add(rule(10, (X1 + 0) = X1))).-step(add(rule(11, (X1 + (-X1 + X2)) = X2))).-step(add(rule(12, -(-X1) = X1))).-step(add(rule(13, (X1 + (X2 + X3)) = (X3 + (X1 + X2))))).-step(add(rule(14, (X1 + (X2 + X3)) = (X2 + (X1 + X3))))).-step(hard((X1 * (X2 + X3)) = (X1 * (X3 + X2)))).-step(hard(((X1 + X2) * X3) = ((X2 + X1) * X3))).-step(add(rule(15, ((X1 + X1) * X2) = (X1 * (X2 + X2))))).-step(add(rule(16, (X2 + (X1 + -X2)) = X1))).-step(add(rule(17, (0 * (X1 + X1)) = (0 * X1)))).-step(add(rule(18, (X1 * (X1 * (X1 * X2))) = (X1 * X2)))).-step(hard((X1 + (X2 + X3)) = (X3 + (X2 + X1)))).-step(hard((X1 + (X2 + X3)) = (X1 + (X3 + X2)))).-step(add(rule(19, (X1 + (X2 + -(X1 + X2))) = 0))).-step(add(rule(20, (X1 + -(-X2 + X1)) = X2))).-step(add(rule(21, (X1 * ((X1 * X1) + X2)) = (X1 + (X1 * X2))))).-step(add(rule(22, (X1 + (X1 * 0)) = X1))).-step(add(rule(23, (X1 * 0) = 0))).-step(add(rule(24, (X1 * (X2 + (X1 * X1))) = (X1 + (X1 * X2))))).-step(add(rule(25, (X2 + -(X1 + X2)) = -X1))).-step(add(rule(26, ((X1 + X1) * (X1 * X1)) = (X1 + X1)))).-step(hard(0 = (X1 + (X2 + -(X2 + X1))))).-step(add(rule(27, (X2 + -(X2 + -X1)) = X1))).-step(add(rule(28, -(-X1 + -X2) = (X2 + X1)))).-step(add(rule(29, (X1 * (0 * X2)) = (0 * X2)))).-step(add(rule(30, (X1 + (X2 * (X1 * X1))) = ((X1 + X2) * (X1 * X1))))).-step(add(rule(31, (X2 + -(X2 + X1)) = -X1))).-step(hard((-X1 + (X2 + (X3 + X1))) = (X3 + X2))).-step(add(rule(32, (X3 + (X2 + (-X3 + X1))) = (X1 + X2)))).-step(add(rule(33, (X3 + (X1 + (X2 + -X3))) = (X1 + X2)))).-step(add(rule(34, -(X1 + -X2) = (X2 + -X1)))).-step(add(rule(35, (-X1 + -X2) = -(X2 + X1)))).-step(add(rule(36, -(-X2 + X1) = (-X1 + X2)))).-step(hard(-(X1 + X2) = -(X2 + X1))).-step(add(rule(37, (X1 + (X1 * -(X1 * X1))) = 0))).-step(add(rule(38, (-X1 * -(-X1 * -X1)) = X1))).-step(add(rule(39, (-X1 * (-X1 * X1)) = X1))).-step(add(rule(40, (X1 * -(X1 * X1)) = -X1))).-step(hard((X1 + (X2 + (X3 + X4))) = (X2 + (X3 + (X4 + X1))))).-step(hard((X1 + (X2 + (X3 + X4))) = (X3 + (X1 + (X2 + X4))))).-step(hard((X1 + (X2 + (X3 + X4))) = (X3 + (X2 + (X4 + X1))))).-step(hard((X1 + (X2 + (X3 + X4))) = (X3 + (X4 + (X1 + X2))))).-step(hard((X1 + (X2 + (X3 + X4))) = (X4 + (X3 + (X1 + X2))))).-step(hard((X1 + (X2 + (X3 + X4))) = (X4 + (X2 + (X3 + X1))))).-step(hard((X1 + (X2 + (X3 + X4))) = (X2 + (X4 + (X1 + X3))))).-step(add(rule(41, ((X1 + X1) * (X2 * X3)) = (X1 * ((X2 + X2) * X3))))).-step(add(rule(42, (X1 * (X1 * (X1 + X1))) = (X1 + X1)))).-step(add(rule(43, (X1 * (X2 * (X3 + X3))) = (X1 * ((X2 + X2) * X3))))).-step(add(rule(44, (X1 * (X2 * (X3 + X3))) = ((X1 + X1) * (X2 * X3))))).-step(add(rule(45, (X1 + (X1 * (X1 * X2))) = (X1 * (X1 * (X1 + X2)))))).-step(add(rule(46, (X1 + (X1 * (X2 * X1))) = (X1 * ((X1 + X2) * X1))))).-step(add(rule(47, (X1 + (0 * X1)) = X1))).-step(add(rule(48, (0 * X1) = 0))).-step(hard((X1 * (X1 * (X1 + X2))) = (X1 * (X1 * (X2 + X1))))).-step(hard((X1 * ((X1 + X2) * X1)) = (X1 * ((X2 + X1) * X1)))).-step(add(rule(49, (X2 + (X3 + (-(X2 + X3) + X1))) = X1))).-step(hard((X1 + (X2 + (-(X2 + X1) + X3))) = X3)).-step(add(rule(50, (X1 * (X1 * -X1)) = -X1))).-step(hard((X1 + X2) = (-X3 + (X2 + (X3 + X1))))).-step(hard((X1 + X2) = (-X3 + (X1 + (X2 + X3))))).-step(hard((X1 + X2) = (-X3 + (X2 + (X1 + X3))))).-step(add(rule(51, ((X1 * X2) + ((X1 * X3) + X4)) = ((X1 * (X2 + X3)) + X4)))).-step(hard(((X1 * (X2 + X3)) + X4) = ((X1 * (X3 + X2)) + X4))).-step(add(rule(52, ((X1 * X2) + ((X3 * X2) + X4)) = (((X1 + X3) * X2) + X4)))).-step(hard((((X1 + X2) * X3) + X4) = (((X2 + X1) * X3) + X4))).-step(add(rule(53, (((X1 + X1) * X2) + X3) = ((X1 * (X2 + X2)) + X3)))).-step(add(rule(54, ((X1 * (X2 * X4)) + (X3 * X4)) = (((X1 * X2) + X3) * X4)))).-step(add(rule(55, (((X1 * X1) + X2) * X1) = (X1 + (X2 * X1))))).-step(add(rule(56, (X1 + (-(X1 * X1) * X1)) = 0))).-step(add(rule(57, (-(X1 * X1) * X1) = -X1))).-step(add(rule(58, ((X1 + (X1 * X2)) * X3) = (X1 * (X3 + (X2 * X3)))))).-step(add(rule(59, ((X2 + (X1 * X1)) * X1) = (X1 + (X2 * X1))))).-step(add(rule(60, ((X1 * X4) + (X2 * (X3 * X4))) = ((X1 + (X2 * X3)) * X4)))).-step(add(rule(61, (X1 * (X2 * (X1 * (X2 * (X1 * X2))))) = (X1 * X2)))).-step(add(rule(62, (X3 + (X2 + -(X3 + X1))) = (-X1 + X2)))).-step(add(rule(63, (X3 + (-(X3 + X2) + X1)) = (X1 + -X2)))).-step(add(rule(64, (X1 * ((X1 * (X1 * X2)) + X3)) = (X1 * (X2 + X3))))).-step(add(rule(65, (X1 * (X2 + (X1 * (X1 * X3)))) = (X1 * (X2 + X3))))).-step(add(rule(66, (X1 * (X2 + X2)) = (X1 * (X1 * ((X1 + X1) * X2)))))).-step(add(rule(67, (X1 * (X1 * (X1 + (X1 * X2)))) = (X1 + (X1 * X2))))).-step(add(rule(68, -((X1 + X1) * X2) = -(X1 * (X2 + X2))))).-step(hard((X1 + -(X3 + X2)) = (-(X2 + X3) + X1))).-step(hard(-(X3 + (X1 + X2)) = -(X1 + (X3 + X2)))).-step(add(rule(69, (X1 + (X1 * (-(X1 * X1) + X2))) = (X1 * X2)))).-step(hard((X1 + (X2 + (X3 + X4))) = (X2 + (X4 + (X3 + X1))))).-step(add(rule(70, (-(X1 * X3) + (X1 * (X2 + X3))) = (X1 * X2)))).-step(add(rule(71, -(X1 * -X2) = (X1 * X2)))).-step(add(rule(72, -(X1 * X2) = (X1 * -X2)))).-step(add(rule(73, (X1 * (X2 * (-X2 * -X2))) = (X1 * X2)))).-step(add(rule(74, (-X1 * (X1 * -X1)) = X1))).-step(add(rule(75, (X1 * (-X1 * -X1)) = X1))).-step(add(rule(76, (-X1 * (X1 * X1)) = -X1))).-step(add(rule(77, (X1 * (-X1 * X1)) = -X1))).-step(add(rule(78, ((X2 * -X3) + ((X1 + X2) * X3)) = (X1 * X3)))).-step(add(rule(79, (-X1 * -X2) = (X1 * X2)))).-step(add(rule(80, (-X1 * X2) = (X1 * -X2)))).-step(add(rule(81, ((X1 * (X2 + X2)) + X3) = (X3 + ((X1 + X1) * X2))))).-step(add(rule(82, (X1 * -(X2 + X2)) = ((X1 + X1) * -X2)))).-step(add(rule(83, (X1 + ((X2 + X2) * X3)) = (X1 + (X2 * (X3 + X3)))))).-step(add(rule(84, (((X1 + X1) * X2) + X3) = (X3 + (X1 * (X2 + X2)))))).-step(add(rule(85, (X2 + (X3 + (X1 + -(X2 + X3)))) = X1))).-step(add(rule(86, ((X1 + (X1 * X1)) * (X1 * X1)) = (X1 + (X1 * X1))))).-step(add(rule(87, ((X1 * X2) + (X3 + (X1 * X4))) = (X3 + (X1 * (X4 + X2)))))).-step(hard((X1 + (X2 * (X3 + X4))) = ((X2 * (X4 + X3)) + X1))).-step(hard((X1 * (X2 + (X3 + X4))) = (X1 * (X4 + (X2 + X3))))).-step(hard((X1 + (X2 * (X3 + X4))) = (X1 + (X2 * (X4 + X3))))).-step(add(rule(88, ((X1 * X2) + (X3 + (X4 * X2))) = (X3 + ((X4 + X1) * X2))))).-step(hard((X1 + ((X2 + X3) * X4)) = (((X3 + X2) * X4) + X1))).-step(hard(((X1 + (X3 + X4)) * X2) = ((X4 + (X1 + X3)) * X2))).-step(hard((X1 + ((X2 + X3) * X4)) = (X1 + ((X3 + X2) * X4)))).-step(add(rule(89, ((X1 + X2) * (X3 + X3)) = ((X1 + (X2 + (X1 + X2))) * X3)))).-step(add(rule(90, ((X1 + (X1 + X2)) * X3) = ((X1 * (X3 + X3)) + (X2 * X3))))).-step(add(rule(91, ((X1 + (X1 + X1)) * X2) = (X1 * (X2 + (X2 + X2)))))).-step(add(rule(92, ((X1 + (X2 + X2)) * X3) = ((X1 * X3) + (X2 * (X3 + X3)))))).-step(add(rule(93, ((X1 + X2) * (X3 + X3)) = ((X2 + (X1 + (X2 + X1))) * X3)))).-step(add(rule(94, ((X1 + X2) * (X3 + X3)) = ((X1 + (X1 + (X2 + X2))) * X3)))).-step(add(rule(95, ((X1 + X1) * (X2 + X3)) = (X1 * (X2 + (X3 + (X2 + X3))))))).-step(add(rule(96, (X1 * (X2 + (X2 + X3))) = (((X1 + X1) * X2) + (X1 * X3))))).-step(add(rule(97, (X1 * (X2 + (X3 + X3))) = ((X1 * X2) + ((X1 + X1) * X3))))).-step(add(rule(98, ((X1 + X1) * (X2 + X3)) = (X1 * (X3 + (X2 + (X3 + X2))))))).-step(add(rule(99, ((X1 + X1) * (X2 + X3)) = (X1 * (X2 + (X2 + (X3 + X3))))))).-step(add(rule(100, (X1 * (((X1 * X1) + X2) * X3)) = ((X1 + (X1 * X2)) * X3)))).-step(add(rule(101, (X1 * (X3 + ((X1 * X1) + X2))) = (X1 + (X1 * (X2 + X3)))))).-step(add(rule(102, (X1 * (X2 + (X3 + (X1 * X1)))) = (X1 + (X1 * (X2 + X3)))))).-step(add(rule(103, (X1 * ((X2 + (X1 * X1)) * X3)) = ((X1 + (X1 * X2)) * X3)))).-step(add(rule(104, (X1 + (-(X2 + X1) + X3)) = (-X2 + X3)))).-step(add(rule(105, (X3 + -(X1 + (X2 + X3))) = -(X1 + X2)))).-step(add(rule(106, (X1 + (X2 + -(X3 + X1))) = (X2 + -X3)))).-step(add(rule(107, (((X1 * X1) + X2) * (X1 * X3)) = ((X1 + (X2 * X1)) * X3)))).-step(add(rule(108, ((X1 + (X2 * X3)) * (X3 * X3)) = (((X1 * X3) + X2) * X3)))).-step(add(rule(109, ((X1 + (X2 * X2)) * (X2 * X3)) = ((X2 + (X1 * X2)) * X3)))).-step(add(rule(110, (X1 * (X1 * -(X1 + X1))) = -(X1 + X1)))).-step(add(rule(111, (X1 * (X1 * ((X1 + X1) * X2))) = ((X1 + X1) * X2)))).-step(add(rule(112, ((X1 + (X1 + X1)) * (X1 * X1)) = (X1 + (X1 + X1))))).-step(add(rule(113, (-X1 + (X2 + -X3)) = (X2 + -(X1 + X3))))).-step(hard((X1 * -(X2 + X3)) = (X1 * -(X3 + X2)))).-step(add(rule(114, ((X1 + (X1 * (X2 * X2))) * X2) = (X1 * (X2 + X2))))).-step(hard(-(X2 + (X3 + X1)) = -(X1 + (X2 + X3)))).-step(hard(-(X3 + (X1 + X2)) = -(X3 + (X2 + X1)))).-step(add(rule(115, (((X1 * (X2 * X2)) + X3) * X2) = ((X1 + X3) * X2)))).-step(hard((X1 + -(X2 + X3)) = (X1 + -(X3 + X2)))).-step(add(rule(116, (X1 + (X1 * (X2 + (X1 * -X1)))) = (X1 * X2)))).-step(add(rule(117, ((X1 * -X3) + ((X1 + X2) * X3)) = (X2 * X3)))).-step(add(rule(118, (X1 + (((X1 * -X1) + X2) * X1)) = (X2 * X1)))).-step(add(rule(119, (X1 + ((X2 + (X1 * -X1)) * X1)) = (X2 * X1)))).-step(add(rule(120, (X1 + ((-X2 + (X1 * X1)) * -X1)) = (X2 * X1)))).-step(interreduce).-step(delete(rule(13, (X1 + (X2 + X3)) = (X3 + (X1 + X2))))).-step(delete(rule(17, (0 * (X1 + X1)) = (0 * X1)))).-step(delete(rule(19, (X1 + (X2 + -(X1 + X2))) = 0))).-step(delete(rule(20, (X1 + -(-X2 + X1)) = X2))).-step(delete(rule(22, (X1 + (X1 * 0)) = X1))).-step(delete(rule(26, ((X1 + X1) * (X1 * X1)) = (X1 + X1)))).-step(delete(rule(27, (X2 + -(X2 + -X1)) = X1))).-step(delete(rule(28, -(-X1 + -X2) = (X2 + X1)))).-step(delete(rule(29, (X1 * (0 * X2)) = (0 * X2)))).-step(delete(rule(37, (X1 + (X1 * -(X1 * X1))) = 0))).-step(delete(rule(38, (-X1 * -(-X1 * -X1)) = X1))).-step(delete(rule(39, (-X1 * (-X1 * X1)) = X1))).-step(delete(rule(40, (X1 * -(X1 * X1)) = -X1))).-step(delete(rule(47, (X1 + (0 * X1)) = X1))).-step(delete(rule(49, (X2 + (X3 + (-(X2 + X3) + X1))) = X1))).-step(delete(rule(56, (X1 + (-(X1 * X1) * X1)) = 0))).-step(delete(rule(57, (-(X1 * X1) * X1) = -X1))).-step(delete(rule(66, (X1 * (X2 + X2)) = (X1 * (X1 * ((X1 + X1) * X2)))))).-step(delete(rule(68, -((X1 + X1) * X2) = -(X1 * (X2 + X2))))).-step(delete(rule(69, (X1 + (X1 * (-(X1 * X1) + X2))) = (X1 * X2)))).-step(add(rule(121, (X1 + (X1 * ((X1 * -X1) + X2))) = (X1 * X2)))).-step(delete(rule(70, (-(X1 * X3) + (X1 * (X2 + X3))) = (X1 * X2)))).-step(delete(rule(71, -(X1 * -X2) = (X1 * X2)))).-step(delete(rule(73, (X1 * (X2 * (-X2 * -X2))) = (X1 * X2)))).-step(delete(rule(74, (-X1 * (X1 * -X1)) = X1))).-step(delete(rule(75, (X1 * (-X1 * -X1)) = X1))).-step(delete(rule(76, (-X1 * (X1 * X1)) = -X1))).-step(delete(rule(77, (X1 * (-X1 * X1)) = -X1))).-step(delete(rule(79, (-X1 * -X2) = (X1 * X2)))).-step(delete(rule(85, (X2 + (X3 + (X1 + -(X2 + X3)))) = X1))).-step(delete(rule(86, ((X1 + (X1 * X1)) * (X1 * X1)) = (X1 + (X1 * X1))))).-step(delete(rule(89, ((X1 + X2) * (X3 + X3)) = ((X1 + (X2 + (X1 + X2))) * X3)))).-step(delete(rule(93, ((X1 + X2) * (X3 + X3)) = ((X2 + (X1 + (X2 + X1))) * X3)))).-step(delete(rule(95, ((X1 + X1) * (X2 + X3)) = (X1 * (X2 + (X3 + (X2 + X3))))))).-step(delete(rule(98, ((X1 + X1) * (X2 + X3)) = (X1 * (X3 + (X2 + (X3 + X2))))))).-step(add(rule(122, ((X1 + (X1 * (X2 * -X2))) * X2) = 0))).-step(add(rule(123, ((X3 * X2) + ((X1 + X3) * -X2)) = (X1 * -X2)))).-step(add(rule(124, ((X1 + (X1 + (X1 + X1))) * X2) = (X1 * (X2 + (X2 + (X2 + X2))))))).-step(add(rule(125, ((X1 * X3) + (X2 * (X1 * (X1 * X3)))) = ((X1 + X2) * (X1 * (X1 * X3)))))).-step(add(rule(126, (X1 * ((X1 + X1) * ((X1 + X1) * (X2 + X2)))) = ((X1 + X1) * X2)))).-step(add(rule(127, (((X1 + X2) * (X1 * X1)) + X3) = (X1 + ((X2 * (X1 * X1)) + X3))))).-step(add(rule(128, (X1 + (X2 * (X3 * (X1 * X1)))) = ((X1 + (X2 * X3)) * (X1 * X1))))).-step(add(rule(129, (X1 + (X2 + (X3 * (X1 * X1)))) = (X2 + ((X1 + X3) * (X1 * X1)))))).-step(add(rule(130, (X1 * (X1 * (X1 + (X1 + X1)))) = (X1 + (X1 + X1))))).-step(add(rule(131, ((X1 + (X2 + X2)) * (X1 * X1)) = (X1 + (X2 * (X1 * (X1 + X1))))))).-step(add(rule(132, ((X1 * (X2 + X3)) + (X4 * X3)) = ((X1 * X2) + ((X1 + X4) * X3))))).-step(add(rule(133, ((X1 * X2) + ((X1 + X3) * -X2)) = (X3 * -X2)))).-step(add(rule(134, (X1 + (X1 * ((X1 * X2) + X3))) = (X1 * ((X1 * (X1 + X2)) + X3))))).-step(add(rule(135, (((X1 + X2) * X3) + (X2 * X4)) = ((X1 * X3) + (X2 * (X3 + X4)))))).-step(add(rule(136, (((X1 + X2) * (X2 * X2)) + X3) = (X2 + ((X1 * (X2 * X2)) + X3))))).-step(add(rule(137, (X1 + (X1 * ((X2 * X1) + X3))) = (X1 * (((X1 + X2) * X1) + X3))))).-step(add(rule(138, (((X1 * X2) + X3) * (X2 * X2)) = ((X1 + (X3 * X2)) * X2)))).-step(add(rule(139, ((X1 + (X2 * (X3 * X3))) * X3) = ((X1 + X2) * X3)))).-step(add(rule(140, (X1 + (X1 * (X2 * (X3 * X1)))) = (X1 * (((X2 * X3) + X1) * X1))))).-step(add(rule(141, ((X1 * -X3) + (X2 * X3)) = ((-X1 + X2) * X3)))).-step(hard(((-X1 + (X2 + X1)) * X3) = (X2 * X3))).-step(hard((X1 * X2) = ((-X3 + (X1 + X3)) * X2))).-step(add(rule(142, (((X1 * -X1) + X2) * -X1) = (X1 + (X2 * -X1))))).-step(add(rule(143, ((X1 + (X2 * -X2)) * -X2) = (X2 + (X1 * -X2))))).-step(add(rule(144, (((X1 * -X1) + X2) * X1) = (-X1 + (X2 * X1))))).-step(add(rule(145, (-X1 + (-X1 + X2)) = (-(X1 + X1) + X2)))).-step(add(rule(146, (X1 * -((X1 * -X1) + X2)) = (X1 + (X1 * -X2))))).-step(add(rule(147, (X1 * ((X1 * -X1) + X2)) = (-X1 + (X1 * X2))))).-step(add(rule(148, (X3 + -(X1 + (X3 + X2))) = -(X1 + X2)))).-step(hard(X1 = (-X3 + (X1 + X3)))).-step(add(rule(149, ((X2 + ((X1 * X1) + X3)) * X1) = (X1 + ((X2 + X3) * X1))))).-step(add(rule(150, (X1 * (X1 * ((X1 * X2) + X3))) = (X1 * (X2 + (X1 * X3)))))).-step(add(rule(151, (X1 * (X1 * (X2 + (X1 * X3)))) = (X1 * ((X1 * X2) + X3))))).-step(hard(((X1 * (X2 + X2)) + (X3 * X2)) = ((X1 + (X3 + X1)) * X2))).-step(add(rule(152, ((X1 + (X1 + X2)) * X3) = ((X2 * X3) + (X1 * (X3 + X3)))))).-step(hard(((X1 * X2) + (X3 * (X2 + X2))) = ((X3 + (X1 + X3)) * X2))).-step(hard(((X1 + (X2 + X2)) * X3) = ((X2 * (X3 + X3)) + (X1 * X3)))).-step(hard(((X1 + (X1 + (X2 + X2))) * X3) = ((X2 + X1) * (X3 + X3)))).-step(hard(((X1 + X2) * (X3 + X3)) = ((X1 + (X2 + (X2 + X1))) * X3))).-step(hard(((X1 + X2) * (X3 + X3)) = ((X1 + (X2 + (X1 + X2))) * X3))).-step(hard((((X1 + X1) * X2) + (X1 * X3)) = (X1 * (X2 + (X3 + X2))))).-step(add(rule(153, (X1 * (X2 + (X2 + X3))) = ((X1 * X3) + ((X1 + X1) * X2))))).-step(hard(((X1 * X2) + ((X1 + X1) * X3)) = (X1 * (X3 + (X2 + X3))))).-step(hard((X1 * (X2 + (X3 + X3))) = (((X1 + X1) * X3) + (X1 * X2)))).-step(hard((X1 * (X2 + (X2 + (X3 + X3)))) = ((X1 + X1) * (X3 + X2)))).-step(hard(((X1 + X1) * (X2 + X3)) = (X1 * (X2 + (X3 + (X3 + X2)))))).-step(hard(((X1 + X1) * (X2 + X3)) = (X1 * (X2 + (X3 + (X2 + X3)))))).-step(add(rule(154, (X1 * ((X1 + X1) * (X1 + (X1 + (X1 + X1))))) = (X1 + X1)))).-step(add(rule(155, (X1 * ((X1 * (X1 + X1)) + X2)) = (X1 + (X1 + (X1 * X2)))))).-step(add(rule(156, (X4 + (X2 + (X3 + (-X4 + X1)))) = (X1 + (X2 + X3))))).-step(hard((X1 + (X2 + X3)) = (X2 + (X3 + X1)))).-step(hard((X1 + (-X2 + (X3 + X2))) = (X1 + X3))).-step(hard((-X1 + (X2 + (X1 + X3))) = (X2 + X3))).-step(hard((-(X1 + X2) + (X3 + X1)) = (X3 + -X2))).-step(hard((X4 + (X5 + (X2 + X3))) = (X4 + (X2 + (X3 + X5))))).-step(hard((-(X1 + X2) + (X3 + X2)) = (-X1 + X3))).-step(add(rule(157, -(X1 + (-X2 + X3)) = (X2 + -(X3 + X1))))).-step(hard(-X1 = (-X2 + (-X1 + X2)))).-step(add(rule(158, (X4 + (X1 + (X2 + (X3 + -X4)))) = (X1 + (X2 + X3))))).-step(add(rule(159, -(X1 + (X2 + -X3)) = (X3 + -(X1 + X2))))).-step(add(rule(160, (-X1 + (-X2 + X3)) = (-(X2 + X1) + X3)))).-step(add(rule(161, -(X3 + (X1 * -X2)) = ((X1 * X2) + -X3)))).-step(add(rule(162, ((X2 * -X3) + -X1) = -(X1 + (X2 * X3))))).-step(add(rule(163, (-X3 + (X1 * -X2)) = -((X1 * X2) + X3)))).-step(add(rule(164, -((X2 * -X3) + X1) = (-X1 + (X2 * X3))))).-step(add(rule(165, ((X1 + -X2) * -X3) = ((X2 + -X1) * X3)))).-step(add(rule(166, ((-X1 + X2) * -X3) = ((-X2 + X1) * X3)))).-step(hard((X1 + (X1 * (-X2 + (X3 + X2)))) = (X1 + (X1 * X3)))).-step(interreduce).-step(delete(rule(67, (X1 * (X1 * (X1 + (X1 * X2)))) = (X1 + (X1 * X2))))).-step(delete(rule(78, ((X2 * -X3) + ((X1 + X2) * X3)) = (X1 * X3)))).-step(delete(rule(114, ((X1 + (X1 * (X2 * X2))) * X2) = (X1 * (X2 + X2))))).-step(delete(rule(117, ((X1 * -X3) + ((X1 + X2) * X3)) = (X2 * X3)))).-step(delete(rule(118, (X1 + (((X1 * -X1) + X2) * X1)) = (X2 * X1)))).-step(delete(rule(120, (X1 + ((-X2 + (X1 * X1)) * -X1)) = (X2 * X1)))).-step(delete(rule(121, (X1 + (X1 * ((X1 * -X1) + X2))) = (X1 * X2)))).-step(delete(rule(145, (-X1 + (-X1 + X2)) = (-(X1 + X1) + X2)))).-step(delete(rule(146, (X1 * -((X1 * -X1) + X2)) = (X1 + (X1 * -X2))))).-step(add(rule(167, ((X1 + X1) * (X1 + (X1 + (X1 + X1)))) = (X1 * (X1 + X1))))).-step(hard((-(X1 + X2) + X3) = (-(X2 + X1) + X3))).-step(add(rule(168, ((X1 * (X2 + X2)) + ((X1 + X1) * -X2)) = 0))).-step(add(rule(169, (((X1 + X1) * X2) + (X1 * -(X2 + X2))) = 0))).-step(add(rule(170, ((X1 * X3) + (X2 * -X3)) = ((-X2 + X1) * X3)))).-step(add(rule(171, ((X1 + (X1 * (X2 * -X2))) * -X2) = 0))).-step(add(rule(172, ((X1 + (X1 * (X2 * -X2))) * (X2 * -X2)) = 0))).-step(hard((X1 + (-X3 + (X2 + X3))) = (X2 + X1))).-step(hard((X1 * X2) = ((-X4 + (X1 + X4)) * X2))).-step(add(rule(173, ((X1 * (X2 + X2)) + ((X1 + X1) * X3)) = ((X1 + X1) * (X2 + X3))))).-step(add(rule(174, (((X1 + X1) * X2) + (X1 * (X3 + X3))) = ((X1 + X1) * (X2 + X3))))).-step(add(rule(175, (X1 + (X1 + ((X1 + X1) * X2))) = ((X1 + X1) * (X2 + (X1 * X1)))))).-step(add(rule(176, (X1 * ((X1 + X1) * (X1 + X1))) = (X1 + (X1 + (X1 + X1)))))).-step(add(rule(177, (((X1 + X1) * X3) + (X2 * (X3 + X3))) = ((X1 + X2) * (X3 + X3))))).-step(add(rule(178, ((X1 * (X3 + X3)) + ((X2 + X2) * X3)) = ((X1 + X2) * (X3 + X3))))).-step(add(rule(179, (X1 + (X1 * -(X2 + (X1 * X1)))) = (X1 * -X2)))).-step(add(rule(180, (X1 + ((X2 + (X1 * X1)) * -X1)) = (X2 * -X1)))).-step(add(rule(181, (X2 + (X3 + (-X1 + X4))) = (X2 + (X4 + (-X1 + X3)))))).-step(hard((X1 + (X2 + (X3 + X4))) = (X1 + (X4 + (X3 + X2))))).-step(add(rule(182, (((X1 + X1) * -X2) + X3) = ((X1 * -(X2 + X2)) + X3)))).-step(add(rule(183, (X1 + ((X2 + X2) * -X3)) = (X1 + (X2 * -(X3 + X3)))))).-step(add(rule(184, (X1 + ((X2 + X2) * -X3)) = ((X2 * -(X3 + X3)) + X1)))).-step(add(rule(185, (X3 * ((X2 + X2) * -X4)) = (X3 * (X2 * -(X4 + X4)))))).-step(add(rule(186, (X1 * (X4 * -(X3 + X3))) = ((X1 + X1) * (X4 * -X3))))).-step(add(rule(187, (X2 + (((X2 * X2) + X1) * -X2)) = (X1 * -X2)))).-step(add(rule(188, ((X1 + (X1 + X1)) * -X2) = (X1 * -(X2 + (X2 + X2)))))).-step(hard((-(X1 + X2) + (X3 + X4)) = (X3 + (X4 + -(X2 + X1))))).-step(add(rule(189, (X1 + (X2 * -(X3 + X3))) = (((X2 + X2) * -X3) + X1)))).-step(add(rule(190, (X1 * (X2 * ((X3 + X3) * X4))) = ((X1 + X1) * (X2 * (X3 * X4)))))).-step(add(rule(191, (X1 * (X2 * ((X3 + X3) * X4))) = (X1 * ((X2 + X2) * (X3 * X4)))))).-step(add(rule(192, ((X1 + X1) * (X2 + (X2 + (X2 + X2)))) = (X1 * (X2 + X2))))).-step(add(rule(193, (X1 * (X2 * ((X3 + X3) * X4))) = (X1 * (X2 * (X3 * (X4 + X4))))))).-step(add(rule(194, (X1 * ((X2 * (X3 + X3)) + X4)) = (X1 * (((X2 + X2) * X3) + X4))))).-step(add(rule(195, (X1 * ((X2 + X2) * (X3 * X4))) = (X1 * (X2 * (X3 * (X4 + X4))))))).-step(add(rule(196, (X1 * (X2 + (X3 * (X4 + X4)))) = (X1 * (X2 + ((X3 + X3) * X4)))))).-step(add(rule(197, ((X1 + X1) * (X2 * (X3 * X4))) = (X1 * (X2 * (X3 * (X4 + X4))))))).-step(interreduce).-step(delete(rule(123, ((X3 * X2) + ((X1 + X3) * -X2)) = (X1 * -X2)))).-step(delete(rule(133, ((X1 * X2) + ((X1 + X3) * -X2)) = (X3 * -X2)))).-step(delete(rule(154, (X1 * ((X1 + X1) * (X1 + (X1 + (X1 + X1))))) = (X1 + X1)))).-step(delete(rule(167, ((X1 + X1) * (X1 + (X1 + (X1 + X1)))) = (X1 * (X1 + X1))))).-step(delete(rule(168, ((X1 * (X2 + X2)) + ((X1 + X1) * -X2)) = 0))).-step(add(rule(198, ((X1 * (X1 * (X1 + X2))) + X3) = (X1 + ((X1 * (X1 * X2)) + X3))))).-step(add(rule(199, (X1 + (X2 + (X1 * (X1 * X3)))) = (X2 + (X1 * (X1 * (X1 + X3))))))).-step(add(rule(200, (X1 * (X1 * (X1 + (X2 + X2)))) = (X1 + (X1 * ((X1 + X1) * X2)))))).-step(add(rule(201, ((X1 * ((X1 + X2) * X1)) + X3) = (X1 + ((X1 * (X2 * X1)) + X3))))).-step(add(rule(202, (X1 + (X2 + (X1 * (X3 * X1)))) = (X2 + (X1 * ((X1 + X3) * X1)))))).-step(add(rule(203, (X1 * ((X1 + (X2 + X2)) * X1)) = (X1 + (X1 * (X2 * (X1 + X1))))))).-step(add(rule(204, ((X2 * -X3) + (((X1 + X2) * X3) + X4)) = ((X1 * X3) + X4)))).-step(hard(((X1 + X3) * X2) = ((-X4 + (X1 + (X4 + X3))) * X2))).-step(hard(((X1 * X2) + X3) = (((-X4 + (X1 + X4)) * X2) + X3))).-step(hard(((-X3 + X1) * X2) = ((-(X3 + X4) + (X1 + X4)) * X2))).-step(add(rule(205, ((X1 * (X2 * (X3 + X3))) + X4) = ((X1 * ((X2 + X2) * X3)) + X4)))).-step(add(rule(206, ((X1 * (X2 * (X3 + X3))) + X4) = (((X1 + X1) * (X2 * X3)) + X4)))).-step(add(rule(207, ((X1 * (X2 + X2)) + (X3 + X4)) = (X3 + (((X1 + X1) * X2) + X4))))).-step(add(rule(208, (((X1 + X1) * X2) + (X3 + X4)) = (X3 + ((X1 * (X2 + X2)) + X4))))).-step(add(rule(209, (X1 + (X1 * ((X2 + X2) * X3))) = (X1 + (X1 * (X2 * (X3 + X3))))))).-step(add(rule(210, (((X1 + X1) * (X2 * X3)) + X4) = ((X1 * ((X2 + X2) * X3)) + X4)))).-step(add(rule(211, ((((X1 + X1) * X2) + X3) * X4) = (((X1 * (X2 + X2)) + X3) * X4)))).-step(add(rule(212, (X1 + ((X1 + (X2 * X1)) * X1)) = ((X1 + ((X1 + X2) * X1)) * X1)))).-step(simplify_queue).-step(interreduce).-step(hard((X1 + X2) = (X2 + (-X4 + (X1 + X4))))).-step(hard((X1 + ((X1 * (X3 + X2)) + X4)) = (X1 + ((X1 * (X2 + X3)) + X4)))).-step(hard((X4 + (X1 * (-X3 + (X2 + X3)))) = ((X1 * X2) + X4))).-step(add(rule(213, (X1 + (X1 * (X1 + (X1 * X2)))) = (X1 * (X1 + (X1 * (X2 + X1))))))).-step(hard((X1 * (X1 + (X1 * (X1 + X2)))) = (X1 * (X1 + (X1 * (X2 + X1)))))).-step(add(rule(214, ((X1 + (X1 * X2)) * (X1 * X1)) = (X1 * ((X1 + (X2 * X1)) * X1))))).-step(add(rule(215, (X1 + (X1 * (X1 + (X2 * X1)))) = (X1 * (X1 + ((X1 + X2) * X1)))))).-step(add(rule(216, (X1 + (((X1 * X2) + X3) * X1)) = (((X1 * (X1 + X2)) + X3) * X1)))).-step(add(rule(217, (X1 + (((X2 * X1) + X3) * X1)) = ((((X1 + X2) * X1) + X3) * X1)))).-step(hard(((-X2 + (X1 + X2)) * (X1 * X1)) = X1)).-step(add(rule(218, ((X1 + (X1 * X2)) * (X3 * X4)) = (X1 * ((X3 + (X2 * X3)) * X4))))).-step(add(rule(219, (X1 * (X2 * (X3 + (X4 * X3)))) = (X1 * ((X2 + (X2 * X4)) * X3))))).-step(add(rule(220, (X1 * (X2 * (X3 + (X2 * X3)))) = ((X1 + (X1 * X2)) * (X2 * X3))))).-step(add(rule(221, (X1 * (X2 + ((X3 + X3) * X2))) = ((X1 + ((X1 + X1) * X3)) * X2)))).-step(add(rule(222, (X1 * (X2 + (X1 * (X3 * X2)))) = (X1 * (X1 * ((X1 + X3) * X2)))))).-step(add(rule(223, (X1 * (X2 + (X3 * (X1 * X2)))) = (X1 * ((X1 + X3) * (X1 * X2)))))).-step(add(rule(224, ((X1 + (X1 * (X2 * X3))) * X4) = (X1 * (X4 + (X2 * (X3 * X4))))))).-step(add(rule(225, ((X1 + (X1 * (X2 + X2))) * X3) = (X1 * (X3 + (X2 * (X3 + X3))))))).-step(add(rule(226, ((X1 + ((X2 + X2) * X3)) * X4) = ((X1 + (X2 * (X3 + X3))) * X4)))).-step(add(rule(227, (X1 * (X3 + (X2 * (X1 * X3)))) = (X1 * ((X2 + X1) * (X1 * X3)))))).-step(add(rule(228, (X1 * -(X2 + (X1 * (X1 * -X2)))) = 0))).-step(add(rule(229, (X1 * -((X1 * X1) + X2)) = -(X1 + (X1 * X2))))).-step(add(rule(230, (X1 * -(X2 + (X1 * X1))) = -(X1 + (X1 * X2))))).-step(add(rule(231, (((X1 * X1) + X2) * -X1) = -(X1 + (X2 * X1))))).-step(interreduce).-step(delete(rule(179, (X1 + (X1 * -(X2 + (X1 * X1)))) = (X1 * -X2)))).-step(delete(rule(187, (X2 + (((X2 * X2) + X1) * -X2)) = (X1 * -X2)))).-step(delete(rule(214, ((X1 + (X1 * X2)) * (X1 * X1)) = (X1 * ((X1 + (X2 * X1)) * X1))))).-step(add(rule(232, ((X1 + (X2 * X2)) * -X2) = -(X2 + (X1 * X2))))).-step(add(rule(233, ((X1 * X2) + (X3 * (X2 + X4))) = ((X3 * X4) + ((X1 + X3) * X2))))).-step(hard((X1 + (X2 + (X2 * (X4 + X3)))) = (X2 + (X1 + (X2 * (X3 + X4)))))).-step(add(rule(234, (X1 + (X1 * (X2 + (X1 * X3)))) = (X1 * (X2 + (X1 * (X3 + X1))))))).-step(hard((X4 + (X1 * (X5 + (X2 + X3)))) = (X4 + (X1 * (X5 + (X3 + X2)))))).-step(add(rule(235, ((X1 * X2) + (X3 * (X4 + X2))) = (((X3 + X1) * X2) + (X3 * X4))))).-step(hard((X1 * (-X2 + (X3 + X2))) = (X1 * X3))).-step(add(rule(236, (X1 + ((X2 + (X1 * X3)) * X1)) = ((X2 + (X1 * (X3 + X1))) * X1)))).-step(add(rule(237, ((X1 * X2) + ((X1 + X3) * X4)) = ((X3 * X4) + (X1 * (X2 + X4)))))).-step(add(rule(238, (X1 + ((X2 + X3) * (X3 * X3))) = (X3 + (X1 + (X2 * (X3 * X3))))))).-step(add(rule(239, (X1 + ((X2 + X3) * (X2 * X2))) = ((X3 * (X2 * X2)) + (X1 + X2))))).-step(add(rule(240, (X1 + (X1 * (X2 + (X3 * X1)))) = (X1 * (X2 + ((X3 + X1) * X1)))))).-step(add(rule(241, ((X1 * X2) + ((X3 + X1) * X4)) = ((X1 * (X4 + X2)) + (X3 * X4))))).-step(hard((X4 + ((X5 + (X1 + X2)) * X3)) = (X4 + ((X5 + (X2 + X1)) * X3)))).-step(add(rule(242, (X1 + ((X2 + (X3 * X1)) * X1)) = ((X2 + ((X3 + X1) * X1)) * X1)))).-step(hard(((X1 + (X1 + X2)) * (X2 * X2)) = (X2 + (X1 * (X2 * (X2 + X2)))))).-step(hard((X1 + (X1 * (X2 * (X1 + X1)))) = (X1 * ((X2 + (X2 + X1)) * X1)))).-step(hard(((X1 + (X1 + (X2 + X2))) * X3) = ((X1 + (X2 + (X1 + X2))) * X3))).-step(add(rule(243, (((X1 * (X1 + X1)) + (X2 + X2)) * X1) = (((X1 * X1) + X2) * (X1 + X1))))).-step(hard((X1 + (X1 * ((X1 + X1) * X2))) = (X1 * (X1 * (X2 + (X2 + X1)))))).-step(add(rule(244, (X1 * (X3 + (X2 * (X3 + X3)))) = ((X1 + ((X1 + X1) * X2)) * X3)))).-step(add(rule(245, (X1 * (X2 + (X2 + (X3 * X2)))) = ((X1 + (X1 + (X1 * X3))) * X2)))).-step(hard((X1 * (X1 * (X2 + (X1 + X1)))) = (X1 * (X1 * (X1 + (X1 + X2)))))).-step(hard((X1 * (X2 + (X2 + (X3 + X3)))) = (X1 * (X2 + (X3 + (X2 + X3)))))).-step(add(rule(246, ((X1 + X1) * ((X1 * X1) + X2)) = (X1 + (X1 + (X1 * (X2 + X2))))))).-step(hard((X1 * (X1 + ((X1 + X2) * X1))) = (X1 * (X1 + ((X2 + X1) * X1))))).-step(add(rule(247, (X1 * (((X1 * (X1 + X1)) + X2) * X3)) = (X1 * (X3 + (X3 + (X2 * X3))))))).-step(interreduce).-step(delete(rule(116, (X1 + (X1 * (X2 + (X1 * -X1)))) = (X1 * X2)))).-step(delete(rule(119, (X1 + ((X2 + (X1 * -X1)) * X1)) = (X2 * X1)))).-step(delete(rule(180, (X1 + ((X2 + (X1 * X1)) * -X1)) = (X2 * -X1)))).-step(delete(rule(212, (X1 + ((X1 + (X2 * X1)) * X1)) = ((X1 + ((X1 + X2) * X1)) * X1)))).-step(delete(rule(213, (X1 + (X1 * (X1 + (X1 * X2)))) = (X1 * (X1 + (X1 * (X2 + X1))))))).-step(delete(rule(215, (X1 + (X1 * (X1 + (X2 * X1)))) = (X1 * (X1 + ((X1 + X2) * X1)))))).-step(add(rule(248, (X1 * (X2 + (X2 + (X1 * (X1 + X1))))) = ((X1 + X1) * ((X1 * X1) + X2))))).-step(add(rule(249, (X1 + (X1 + (X1 * (X2 + X2)))) = ((X1 + X1) * (X2 + (X1 * X1)))))).-step(hard((X1 * (X1 * ((X1 + X2) * X3))) = (X1 * (X1 * ((X2 + X1) * X3))))).-step(hard((X1 * ((X1 + X2) * (X1 * X3))) = (X1 * ((X2 + X1) * (X1 * X3))))).-step(add(rule(250, ((X1 + ((X1 * X1) + X2)) * (X1 * X1)) = ((X1 + ((X2 + X1) * X1)) * X1)))).-step(add(rule(251, ((X1 + (X1 * (X2 * X3))) * X3) = (X1 * ((X2 + X3) * (X3 * X3)))))).-step(hard((X1 * ((X2 + X1) * X2)) = (X1 * ((X1 + X2) * X2)))).-step(add(rule(252, ((X1 + (X2 + (X1 * X1))) * (X1 * X1)) = ((X1 + ((X2 + X1) * X1)) * X1)))).-step(add(rule(253, (X1 * ((X1 + (X2 * (X1 * X2))) * (X1 * X2))) = ((X1 + X1) * X2)))).-step(hard((X1 + ((X2 * (X1 * X1)) + X3)) = (X3 + ((X1 + X2) * (X1 * X1))))).-step(hard(((X1 + ((X2 + X1) * X1)) * X1) = ((X1 + ((X1 + X2) * X1)) * X1))).-step(hard(((X1 + (X2 + X3)) * (X1 * X1)) = ((X2 + (X1 + X3)) * (X1 * X1)))).-step(hard(((X2 + ((X3 + X1) * X1)) * X1) = ((X2 + ((X1 + X3) * X1)) * X1))).-step(hard((X1 + (X2 * (X1 * (X1 + X1)))) = ((X2 + (X1 + X2)) * (X1 * X1)))).-step(add(rule(254, ((X1 * X2) + ((X1 + X3) * X4)) = ((X1 * (X4 + X2)) + (X3 * X4))))).-step(add(rule(255, ((X1 * (X2 + X3)) + (X4 * X3)) = (((X1 + X4) * X3) + (X1 * X2))))).-step(add(rule(256, ((X1 * (X2 + X3)) + (X4 * X3)) = ((X1 * X2) + ((X4 + X1) * X3))))).-step(hard((X1 * ((X1 * (X1 + X2)) + X3)) = (X1 * (X3 + (X1 * (X2 + X1)))))).-step(add(rule(257, ((X1 * X2) + (X3 * (X2 + X4))) = (((X3 + X1) * X2) + (X3 * X4))))).-step(hard((((X1 + X2) * X3) + (X2 * X4)) = ((X2 * (X3 + X4)) + (X1 * X3)))).-step(add(rule(258, (((X1 + X2) * X3) + (X2 * X4)) = ((X1 * X3) + (X2 * (X4 + X3)))))).-step(hard((X1 + ((X2 * (X1 * X1)) + X3)) = (X3 + ((X2 + X1) * (X1 * X1))))).-step(hard(((((X1 + X2) * X1) + X3) * X1) = ((((X2 + X1) * X1) + X3) * X1))).-step(hard((X1 * (((X1 + X2) * X1) + X3)) = (X1 * (X3 + ((X2 + X1) * X1))))).-step(add(rule(259, ((X1 + (X1 * (X2 * X3))) * X3) = (X1 * ((X3 + X2) * (X3 * X3)))))).-step(add(rule(260, ((X2 + (X1 * -X1)) * X1) = (-X1 + (X2 * X1))))).-step(add(rule(261, (X1 * (X2 + (X1 * -X1))) = (-X1 + (X1 * X2))))).-step(add(rule(262, ((X1 + X1) * (X2 + (X2 + X2))) = ((X1 + (X1 + X1)) * (X2 + X2))))).-step(interreduce).-step(delete(rule(241, ((X1 * X2) + ((X3 + X1) * X4)) = ((X1 * (X4 + X2)) + (X3 * X4))))).-step(delete(rule(255, ((X1 * (X2 + X3)) + (X4 * X3)) = (((X1 + X4) * X3) + (X1 * X2))))).-step(add(rule(263, (X1 + (X1 + (X2 * (X1 + X1)))) = (((X1 * X1) + X2) * (X1 + X1))))).-step(add(rule(264, (X2 + (X2 + (X1 * (X2 * (X2 + X2))))) = ((X1 + X2) * (X2 * (X2 + X2)))))).-step(add(rule(265, (X3 + (X4 + (X2 + (-(X3 + X4) + X1)))) = (X1 + X2)))).-step(hard((X1 + -X2) = (-(X2 + X3) + (X1 + X3)))).-step(hard((X1 + (X2 + (X3 + X4))) = (X1 + (X2 + (X4 + X3))))).-step(hard((X3 + (X4 + (X5 + X2))) = (X3 + (X5 + (X4 + X2))))).-step(hard((X1 + X2) = (X2 + (-(X4 + X5) + (X1 + (X4 + X5)))))).-step(add(rule(266, (X3 + (X4 + (X1 + (X2 + -(X3 + X4))))) = (X1 + X2)))).-step(add(rule(267, (X1 * (X2 + (X1 * (X1 + X1)))) = (X1 + (X1 + (X1 * X2)))))).-step(add(rule(268, ((X2 + (X3 + (X1 * X1))) * X1) = (X1 + ((X2 + X3) * X1))))).-step(add(rule(269, (X1 * (X2 + ((X1 * (X1 * -X2)) + X3))) = (X1 * X3)))).-step(hard((X1 * X2) = (X1 * (-X3 + (X2 + X3))))).-step(add(rule(270, (X1 * (X2 + (X3 + (X1 * (X1 * -X2))))) = (X1 * X3)))).-step(hard((X1 + -X2) = (-X3 + (X1 + (X3 + -X2))))).-step(add(rule(271, ((X1 + X1) * (X2 + X2)) = (X1 * ((X1 + X1) * ((X1 + X1) * X2)))))).-step(add(rule(272, ((X1 + X1) * ((X1 + X1) * (X2 + X2))) = (X1 * ((X1 + X1) * X2))))).-step(hard((-X2 + X1) = (-(X2 + X3) + (X1 + X3)))).-step(add(rule(273, (((X1 * (X1 + X1)) + X2) * X1) = (X1 + (X1 + (X2 * X1)))))).-step(hard(((X1 + (X3 + (X3 + X1))) * X2) = ((X3 + X1) * (X2 + X2)))).-step(add(rule(274, ((X1 + (X2 * (X2 + X2))) * X2) = (X2 + (X2 + (X1 * X2)))))).-step(hard((X1 * (X2 + (X3 + (X3 + X2)))) = ((X1 + X1) * (X3 + X2)))).-step(hard((X1 + (X2 + X3)) = (-X4 + (X2 + (X3 + (X4 + X1)))))).-step(hard((X1 + (-X2 + (X3 + (X4 + X2)))) = (X1 + (X4 + X3)))).-step(hard((X1 + (X2 + X3)) = (-X4 + (X1 + (X2 + (X3 + X4)))))).-step(hard((X1 + (X2 + (-X3 + (X4 + X3)))) = (X1 + (X2 + X4)))).-step(hard(((X1 * X2) + X3) = (((-X5 + (X1 + X5)) * X2) + X3))).-step(hard((X1 + ((-X2 + (X4 + X2)) * X3)) = (X1 + (X4 * X3)))).-step(hard((X1 + (X3 + (-X2 + (X4 + X2)))) = (X3 + (X4 + X1)))).-step(hard((X1 * (X2 * X3)) = (X1 * (X2 * (-X4 + (X3 + X4)))))).-step(hard((X1 * (X2 * X3)) = (X1 * ((-X4 + (X2 + X4)) * X3)))).-step(add(rule(275, (X1 * (X2 + (X1 * (X1 + (X1 * -X2))))) = X1))).-step(hard(((X1 * -(X2 + X2)) + ((X1 + X1) * X2)) = 0)).-step(add(rule(276, (X1 * (X2 * (X1 * (X2 * (X1 * (X2 * X3)))))) = (X1 * (X2 * X3))))).-step(interreduce).-step(delete(rule(126, (X1 * ((X1 + X1) * ((X1 + X1) * (X2 + X2)))) = ((X1 + X1) * X2)))).-step(delete(rule(243, (((X1 * (X1 + X1)) + (X2 + X2)) * X1) = (((X1 * X1) + X2) * (X1 + X1))))).-step(add(rule(277, (X1 + (X1 + ((X2 + X2) * X1))) = (((X1 * X1) + X2) * (X1 + X1))))).-step(add(rule(278, ((X1 * X2) + (X3 + ((X1 * X4) + X5))) = (X3 + ((X1 * (X2 + X4)) + X5))))).-step(hard((X1 + (X2 * (X3 + (X4 + X5)))) = (X1 + (X2 * (X4 + (X5 + X3)))))).-step(hard(((X1 * (X2 + (X3 + X4))) + X5) = ((X1 * (X3 + (X2 + X4))) + X5))).-step(add(rule(279, ((X1 * (X2 + (X2 + X3))) + X4) = (((X1 + X1) * X2) + ((X1 * X3) + X4))))).-step(add(rule(280, (X4 + ((X1 * (X2 + X2)) + X5)) = (((X1 + X1) * X2) + (X5 + X4))))).-step(add(rule(281, ((X1 * (X2 + (X2 + X2))) + X3) = (((X1 + (X1 + X1)) * X2) + X3)))).-step(add(rule(282, (-? + ((X2 * (X3 + X3)) + ?)) = ((X2 + X2) * X3)))).-step(add(rule(283, (-X1 + ((X2 * (X3 + X3)) + X1)) = (-? + ((X2 * (X3 + X3)) + ?))))).-step(add(rule(284, ((X1 * (X2 + (X3 + X3))) + X4) = ((X1 * X2) + (((X1 + X1) * X3) + X4))))).-step(add(rule(285, (X1 + (((X1 + X1) * X2) + X3)) = (X1 + ((X1 * (X2 + X2)) + X3))))).-step(add(rule(286, ((X1 * (X2 * X4)) + ((X3 * X4) + X5)) = ((((X1 * X2) + X3) * X4) + X5)))).-step(add(rule(287, ((-X3 + ((X1 * X2) + X3)) * X4) = (X1 * (X2 * X4))))).-step(add(rule(288, ((X1 * X3) + ((X2 * (X1 * X3)) + X4)) = (((X1 + (X2 * X1)) * X3) + X4)))).-step(add(rule(289, (((X1 + (X1 * X2)) * X3) + X4) = ((X1 * (X3 + (X2 * X3))) + X4)))).-step(add(rule(290, ((X1 + (X1 * X2)) * -X3) = (X1 * -(X3 + (X2 * X3)))))).-step(hard(((X1 + X1) * X2) = ((-X3 + (X1 + (X1 + X3))) * X2))).-step(add(rule(291, ((X1 * X4) + ((X2 * (X3 * X4)) + X5)) = (((X1 + (X2 * X3)) * X4) + X5)))).-step(add(rule(292, ((X1 * X2) + (X3 + ((X4 * X2) + X5))) = (X3 + (((X1 + X4) * X2) + X5))))).-step(hard((X1 + ((-X3 + (X2 + X3)) * X4)) = ((X2 * X4) + X1))).-step(hard((X1 + ((X2 + (X3 + X5)) * X4)) = (X1 + ((X3 + (X5 + X2)) * X4)))).-step(hard((((X1 + (X3 + X4)) * X2) + X5) = (((X3 + (X1 + X4)) * X2) + X5))).-step(add(rule(293, (X1 + (((X2 + X2) * X3) + X4)) = (X1 + ((X2 * (X3 + X3)) + X4))))).-step(add(rule(294, (((X1 + (X1 + X2)) * X3) + X4) = ((X1 * (X3 + X3)) + ((X2 * X3) + X4))))).-step(hard(((-X2 + (X1 + (X1 + X2))) * X3) = (X1 * (X3 + X3)))).-step(add(rule(295, (((X1 + (X2 + X2)) * X3) + X4) = ((X1 * X3) + ((X2 * (X3 + X3)) + X4))))).-step(add(rule(296, ((X1 * (X2 * (X3 * X5))) + (X4 * X5)) = (((X1 * (X2 * X3)) + X4) * X5)))).-step(add(rule(297, ((X1 * (X2 * X5)) + (X3 * (X4 * X5))) = (((X1 * X2) + (X3 * X4)) * X5)))).-step(add(rule(298, ((X1 * X4) + (X2 * (X3 * (X1 * X4)))) = ((X1 + (X2 * (X3 * X1))) * X4)))).-step(add(rule(299, ((X1 * (X2 * X3)) + (X4 + (X5 * X3))) = (X4 + (((X1 * X2) + X5) * X3))))).-step(add(rule(300, ((X1 + ((X3 * X4) + X5)) * X2) = (((X3 * X4) + (X1 + X5)) * X2)))).-step(hard(((X1 + (X2 + X3)) * X4) = ((X2 + (X1 + X3)) * X4))).-step(add(rule(301, ((X2 * X4) + (X1 + (X3 * (X2 * X4)))) = (X1 + ((X2 + (X3 * X2)) * X4))))).-step(hard(((((X1 + X4) * X2) + X5) * X3) = ((((X4 + X1) * X2) + X5) * X3))).-step(add(rule(302, (X1 + ((X2 + (X2 * X3)) * X4)) = (X1 + (X2 * (X4 + (X3 * X4))))))).-step(add(rule(303, ((((X1 + X1) * X2) + X3) * X4) = ((X1 * (X2 * (X4 + X4))) + (X3 * X4))))).-step(add(rule(304, ((X1 + X1) * ((X2 + (X1 * X1)) * X3)) = (X1 * (((X3 * X3) + X2) * (X3 + X3)))))).-step(add(rule(305, ((X1 + X1) * (-X2 + (X1 * (X1 * X2)))) = 0))).-step(add(rule(306, (((X1 * (X2 + X2)) + X3) * X4) = ((X1 * (X2 * (X4 + X4))) + (X3 * X4))))).-step(add(rule(307, (((X1 * X2) + (X3 + X3)) * X4) = ((X1 * (X2 * X4)) + (X3 * (X4 + X4)))))).-step(interreduce).-step(delete(rule(125, ((X1 * X3) + (X2 * (X1 * (X1 * X3)))) = ((X1 + X2) * (X1 * (X1 * X3)))))).-step(delete(rule(282, (-? + ((X2 * (X3 + X3)) + ?)) = ((X2 + X2) * X3)))).-step(delete(rule(283, (-X1 + ((X2 * (X3 + X3)) + X1)) = (-? + ((X2 * (X3 + X3)) + ?))))).-step(add(rule(308, (-X1 + ((X2 * (X3 + X3)) + X1)) = (X2 * (X3 + X3))))).-step(delete(rule(285, (X1 + (((X1 + X1) * X2) + X3)) = (X1 + ((X1 * (X2 + X2)) + X3))))).-step(delete(rule(288, ((X1 * X3) + ((X2 * (X1 * X3)) + X4)) = (((X1 + (X2 * X1)) * X3) + X4)))).-step(hard((X1 + X1) = (-X2 + (X1 + (X1 + X2))))).-step(hard((X1 + X2) = (-X3 + (X1 + (X3 + X2))))).-step(add(rule(309, ((X1 + X1) * ((X2 + (X1 * X1)) * X3)) = ((X1 + X1) * (X3 + (X2 * X3)))))).-step(add(rule(310, (((X1 * X2) + X3) * (X2 * (X2 * X4))) = ((X1 + (X3 * X2)) * (X2 * X4))))).-step(add(rule(311, ((X1 + (X1 * (X2 * -X2))) * (X2 * X3)) = 0))).-step(add(rule(312, (X1 * (X2 + (X2 * (X1 * -X1)))) = 0))).-step(hard((X1 * ((-X2 + (X1 + X2)) * X1)) = X1)).-step(add(rule(313, ((X1 + (X1 * (X2 * -X2))) * (X2 + X2)) = 0))).-step(add(rule(314, (X1 * ((X2 + (X1 * (X1 * -X2))) * X3)) = 0))).-step(add(rule(315, ((X1 + (X2 * (X2 * -X1))) * X2) = 0))).-step(add(rule(316, (X1 * ((X2 + (X2 * (X1 * -X1))) * X3)) = 0))).-step(add(rule(317, (X1 * -(X2 + (X2 * (X1 * -X1)))) = 0))).-step(add(rule(318, ((-X1 + (X2 * (X2 * X1))) * X2) = 0))).-step(add(rule(319, ((X1 * X5) + (X2 * (X3 * (X4 * X5)))) = ((X1 + (X2 * (X3 * X4))) * X5)))).-step(add(rule(320, ((X1 * X2) + (X3 + (X4 * (X5 * X2)))) = (X3 + ((X1 + (X4 * X5)) * X2))))).-step(hard(((X4 + ((X5 + X1) * X2)) * X3) = ((X4 + ((X1 + X5) * X2)) * X3))).-step(hard(((X2 + (X1 * (X3 + X1))) * X1) = ((X2 + (X1 * (X1 + X3))) * X1))).-step(add(rule(321, ((X1 + (X1 + (X2 * X3))) * X4) = ((X1 * (X4 + X4)) + (X2 * (X3 * X4)))))).-step(add(rule(322, ((X1 + ((X2 + X2) * X3)) * X4) = ((X1 * X4) + (X2 * (X3 * (X4 + X4))))))).-step(add(rule(323, (X1 + (X2 * (X3 * (X1 + X1)))) = (X1 + ((X2 + X2) * (X3 * X1)))))).-step(add(rule(324, ((X1 + (X2 * (X3 + X3))) * X4) = ((X1 * X4) + (X2 * (X3 * (X4 + X4))))))).-step(add(rule(325, (X1 + (X2 * (X3 * (X1 + X1)))) = (X1 + (X2 * ((X3 + X3) * X1)))))).-step(add(rule(326, ((X1 + (X2 * X3)) * (X3 * (X3 * X4))) = (((X1 * X3) + X2) * (X3 * X4))))).-step(add(rule(327, (X1 * ((X2 * (X1 * (X2 * (X1 * X2)))) + X3)) = (X1 * (X2 + X3))))).-step(add(rule(328, (X1 * (X2 + (X3 * (X1 * (X3 * (X1 * X3)))))) = (X1 * (X2 + X3))))).-step(add(rule(329, (X1 + (X2 + (-(X1 + X3) + X4))) = (-X3 + (X2 + X4))))).-step(hard(-(X3 + (X2 + X1)) = -(X1 + (X2 + X3)))).-step(add(rule(330, (X4 + (X2 + (X3 + -(X4 + X1)))) = (-X1 + (X2 + X3))))).-step(hard((-(X1 + X2) + (X3 + X1)) = (-X2 + X3))).-step(add(rule(331, (X4 + (X3 + -(X1 + (X4 + X2)))) = (-(X1 + X2) + X3)))).-step(hard((X1 + X2) = (-X4 + (X1 + (X4 + X2))))).-step(add(rule(332, (X4 + (-(X2 + (X4 + X3)) + X1)) = (X1 + -(X2 + X3))))).-step(hard((X1 + X2) = (-X4 + (X2 + (X4 + X1))))).-step(add(rule(333, (X2 + ((X2 + X1) * (X2 * -X2))) = (X1 * (X2 * -X2))))).-step(add(rule(334, (X2 + (X1 * (X2 * -X2))) = ((-X1 + X2) * (X2 * X2))))).-step(add(rule(335, (X1 + (X1 * (X2 * -X1))) = (X1 * ((-X2 + X1) * X1))))).-step(add(rule(336, (((X1 * (X2 * (X1 * X2))) + X3) * (X1 * X2)) = ((X1 + (X3 * X1)) * X2)))).-step(add(rule(337, (X1 * (X2 + (X3 * X2))) = (X1 * (X1 * ((X1 + (X1 * X3)) * X2)))))).-step(add(rule(338, (X1 * (((X1 * (X1 * X2)) + X3) * X4)) = (X1 * ((X2 + X3) * X4))))).-step(add(rule(339, (X1 * (X2 + ((X1 * (X1 * X3)) + X4))) = (X1 * (X2 + (X3 + X4)))))).-step(hard((X1 * (X2 + (X3 + X4))) = (X1 * (X3 + (X2 + X4))))).-step(add(rule(340, (X1 * (X2 + (X2 + X3))) = (X1 * ((X1 * ((X1 + X1) * X2)) + X3))))).-step(interreduce).-step(delete(rule(172, ((X1 + (X1 * (X2 * -X2))) * (X2 * -X2)) = 0))).-step(delete(rule(269, (X1 * (X2 + ((X1 * (X1 * -X2)) + X3))) = (X1 * X3)))).-step(delete(rule(298, ((X1 * X4) + (X2 * (X3 * (X1 * X4)))) = ((X1 + (X2 * (X3 * X1))) * X4)))).-step(delete(rule(301, ((X2 * X4) + (X1 + (X3 * (X2 * X4)))) = (X1 + ((X2 + (X3 * X2)) * X4))))).-step(delete(rule(333, (X2 + ((X2 + X1) * (X2 * -X2))) = (X1 * (X2 * -X2))))).-step(add(rule(341, (X1 * ((X1 * (X1 + (X1 * X2))) + X3)) = (X1 + (X1 * (X2 + X3)))))).-step(add(rule(342, (X1 * (X2 + (X3 + (X1 * (X1 * X4))))) = (X1 * (X2 + (X3 + X4)))))).-step(hard((X1 * (X2 + (X3 + X4))) = (X1 * (X2 + (X4 + X3))))).-step(add(rule(343, (X1 * ((X2 + (X1 * (X1 * X3))) * X4)) = (X1 * ((X2 + X3) * X4))))).-step(hard((X1 * ((X2 + X3) * X4)) = (X1 * ((X3 + X2) * X4)))).-step(add(rule(344, (X1 * (X2 + (X3 + X3))) = (X1 * (X2 + (X1 * ((X1 + X1) * X3))))))).-step(add(rule(345, (X1 * (X2 + (X1 * (X1 + (X1 * X3))))) = (X1 + (X1 * (X3 + X2)))))).-step(add(rule(346, (-X1 + (X2 * (X1 * X1))) = ((-X1 + X2) * (X1 * X1))))).-step(add(rule(347, (X1 * (X1 * (-X1 + X2))) = (X1 * (X1 * (X2 + -X1)))))).-step(hard(((X1 * -(X2 + X3)) + X4) = ((X1 * -(X3 + X2)) + X4))).-step(add(rule(348, ((X1 + (X1 * -X2)) * X3) = (X1 * (X3 + (X2 * -X3)))))).-step(hard((X1 + (X2 * -(X3 + X4))) = (X1 + (X2 * -(X4 + X3))))).-step(add(rule(349, (X1 * (X1 * ((X1 + (X1 * X2)) * X3))) = ((X1 + (X1 * X2)) * X3)))).-step(add(rule(350, -(((X1 + X1) * X2) + X3) = -((X1 * (X2 + X2)) + X3)))).-step(add(rule(351, -(X1 + ((X2 + X2) * X3)) = -(X1 + (X2 * (X3 + X3)))))).-step(add(rule(352, -((X1 * (X2 + X2)) + X3) = -(X3 + ((X1 + X1) * X2))))).-step(add(rule(353, -(((X1 + X1) * X2) + X3) = -(X3 + (X1 * (X2 + X2)))))).-step(add(rule(354, (((X1 * (X2 * (X3 * X3))) + X4) * X3) = (((X1 * X2) + X4) * X3)))).-step(add(rule(355, (((X1 * (X2 * (X2 + X2))) + X3) * X2) = ((X1 + (X1 + X3)) * X2)))).-step(hard((X1 + (X3 + -(X4 + X2))) = (X3 + (X1 + -(X2 + X4))))).-step(add(rule(356, ((X1 + (X2 * (X3 * X1))) * (X1 * X1)) = (X1 + (X2 * (X3 * X1)))))).-step(add(rule(357, ((X1 + (X2 * (X3 * (X4 * X4)))) * X4) = ((X1 + (X2 * X3)) * X4)))).-step(add(rule(358, ((X1 + (X2 * (X3 * (X3 + X3)))) * X3) = ((X1 + (X2 + X2)) * X3)))).-step(hard(((-(X1 + X2) + X4) * X3) = ((-(X2 + X1) + X4) * X3))).-step(add(rule(359, ((-X1 + X2) * (X1 * -X1)) = ((-X2 + X1) * (X1 * X1))))).-step(add(rule(360, (-X1 + (X1 * (X2 * X1))) = (X1 * ((-X1 + X2) * X1))))).-step(add(rule(361, (-X1 + (X2 * (X1 * -X1))) = ((X1 + X2) * (X1 * -X1))))).-step(add(rule(362, (-X1 + (X1 * (X1 * X2))) = (X1 * (X1 * (-X1 + X2)))))).-step(add(rule(363, (-X1 + (X1 * (X2 * -X1))) = (X1 * ((X1 + X2) * -X1))))).-step(add(rule(364, ((X1 + X1) * ((X1 * (X1 * X2)) + X3)) = ((X1 + X1) * (X2 + X3))))).-step(add(rule(365, ((X1 + X1) * (X2 + (X1 * (X1 * -X2)))) = 0))).-step(add(rule(366, ((X1 + X1) * (X2 + (X1 * (X1 * X3)))) = ((X1 + X1) * (X2 + X3))))).-step(add(rule(367, (X1 * ((X1 + X1) * -(X1 + X1))) = -(X1 + (X1 + (X1 + X1)))))).-step(add(rule(368, ((X1 + X1) * (X1 + (X1 + X1))) = 0))).-step(interreduce).-step(delete(rule(270, (X1 * (X2 + (X3 + (X1 * (X1 * -X2))))) = (X1 * X3)))).-step(delete(rule(275, (X1 * (X2 + (X1 * (X1 + (X1 * -X2))))) = X1))).-step(delete(rule(305, ((X1 + X1) * (-X2 + (X1 * (X1 * X2)))) = 0))).-step(delete(rule(314, (X1 * ((X2 + (X1 * (X1 * -X2))) * X3)) = 0))).-step(delete(rule(337, (X1 * (X2 + (X3 * X2))) = (X1 * (X1 * ((X1 + (X1 * X3)) * X2)))))).-step(delete(rule(365, ((X1 + X1) * (X2 + (X1 * (X1 * -X2)))) = 0))).-step(add(rule(369, ((X1 + (X1 + X1)) * -(X1 + X1)) = 0))).-step(add(rule(370, ((X1 + X1) * -(X1 + (X1 + X1))) = 0))).-step(add(rule(371, ((X1 + (X1 + X1)) * ((X1 + X1) * -X2)) = 0))).-step(add(rule(372, ((X1 + (X1 + X1)) * -(X1 + (X1 + (X1 + X1)))) = 0))).-step(add(rule(373, ((X1 + X1) * ((X1 + (X1 + X1)) * -X2)) = 0))).-step(add(rule(374, ((X1 + X1) * ((X1 + (X1 + X1)) * X2)) = 0))).-step(add(rule(375, ((X1 + (X1 + (X1 + X1))) * (X1 + (X1 + X1))) = 0))).-step(add(rule(376, ((X1 + (X1 + X1)) * ((X1 + X1) * X2)) = 0))).-step(add(rule(377, ((X1 + (X1 + X1)) * (X1 + (X1 + (X1 + X1)))) = 0))).-step(add(rule(378, ((X1 + X1) * (X2 * (X1 + (X1 + X1)))) = 0))).-step(add(rule(379, ((X1 + (X1 + X1)) * (X2 * (X1 + X1))) = 0))).-step(hard((X1 + (X2 + (-X3 + X4))) = (X4 + (-X3 + (X2 + X1))))).-step(add(rule(380, (X1 + (-X2 + (X3 + X4))) = (X3 + (-X2 + (X1 + X4)))))).-step(hard((X2 + -X1) = (-(X1 + X4) + (X2 + X4)))).-step(hard((X1 + (X2 + (X3 + X4))) = (X3 + (X2 + (X1 + X4))))).-step(hard((X1 + (-(X3 + X2) + X4)) = (X1 + (X4 + -(X2 + X3))))).-step(hard((X2 + (-(X3 + X1) + X4)) = (X2 + (-(X1 + X3) + X4)))).-step(hard((X1 + (X3 + -(X4 + X2))) = (X1 + (X3 + -(X2 + X4))))).-step(hard((X1 + -(X4 + (X3 + X2))) = (X1 + -(X4 + (X2 + X3))))).-step(add(rule(381, (-X1 + (X2 + (X1 * -X1))) = (X2 + -(X1 + (X1 * X1)))))).-step(hard(-(((X1 + X2) * X3) + X4) = -(X4 + ((X2 + X1) * X3)))).-step(add(rule(382, ((X1 + (X1 * X2)) * (X2 * -X2)) = (X1 * -(X2 + (X2 * X2)))))).-step(add(rule(383, (((X1 * (X2 * X2)) + X3) * (X2 * X4)) = ((X1 + X3) * (X2 * X4))))).-step(add(rule(384, ((X1 + (X2 * (X3 * X3))) * (X3 * X4)) = ((X1 + X2) * (X3 * X4))))).-step(hard((-(X2 + (X3 + X1)) + X4) = (X4 + -(X2 + (X1 + X3))))).-step(hard((-(X2 + (X3 + X1)) + X4) = (-(X3 + (X1 + X2)) + X4))).-step(hard((-(X2 + (X3 + X1)) + X4) = (X4 + -(X3 + (X2 + X1))))).-step(hard((X2 + -(X1 + (X3 + X4))) = (X2 + -(X4 + (X3 + X1))))).-step(hard((X1 + (X3 + -(X4 + X2))) = (X3 + (-(X2 + X4) + X1)))).-step(hard(-(X3 + (X4 + (X1 + X2))) = -(X4 + (X1 + (X3 + X2))))).-step(hard(-(X3 + (X4 + (X1 + X2))) = -(X1 + (X4 + (X2 + X3))))).-step(hard((X2 + -(X1 + (X3 + X4))) = (X2 + -(X3 + (X1 + X4))))).-step(hard(-(X3 + (X4 + (X1 + X2))) = -(X3 + (X1 + (X4 + X2))))).-step(hard(-(X3 + (X4 + (X1 + X2))) = -(X1 + (X3 + (X2 + X4))))).-step(hard((X2 + -(X1 + (X3 + X4))) = (-(X3 + (X4 + X1)) + X2))).-step(hard((X1 + (-(X3 + X5) + X4)) = (X4 + (-(X5 + X3) + X1)))).-step(add(rule(385, (X1 * (X1 * (-X1 + ((X1 + X1) * X2)))) = (-X1 + (X1 * (X2 + X2)))))).-step(add(rule(386, (X1 + (X1 * (X2 + ((X1 * -X1) + X3)))) = (X1 * (X3 + X2))))).-step(add(rule(387, -(X1 + (X1 + (X1 + X1))) = (X1 + X1)))).-step(add(rule(388, -(X1 + (X1 + X1)) = (X1 + (X1 + X1))))).-step(add(rule(389, (X1 + (X1 + (X1 + X1))) = -(X1 + X1)))).-step(add(rule(390, ((X1 + X1) * -(X2 + X2)) = (X1 * (X2 + X2))))).-step(add(rule(391, ((X1 + X1) * (X2 + (X2 + X2))) = 0))).-step(add(rule(392, ((X1 + (X1 + X1)) * (X2 + X2)) = 0))).-step(add(rule(393, ((X1 + X1) * (X2 + X2)) = (X1 * -(X2 + X2))))).-step(hard((X1 * (X2 + (-X3 + (X4 + X3)))) = (X1 * (X2 + X4)))).-step(add(rule(394, (X1 + (X1 * (X2 + (X3 + (X1 * -X1))))) = (X1 * (X2 + X3))))).-step(add(rule(395, (((X1 + X2) * X3) + (X4 + (X2 * -X3))) = ((X1 * X3) + X4)))).-step(hard(((X1 * X2) + X3) = (X3 + ((-X4 + (X1 + X4)) * X2)))).-step(hard(-(X1 + ((X2 + X3) * X4)) = -(X1 + ((X3 + X2) * X4)))).-step(add(rule(396, ((X1 * -X3) + (((X1 + X2) * X3) + X4)) = (X4 + (X2 * X3))))).-step(add(rule(397, (((X1 + X2) * X3) + (X4 + (X1 * -X3))) = ((X2 * X3) + X4)))).-step(hard(((-X1 + (X3 + (X4 + X1))) * X2) = ((X3 + X4) * X2))).-step(hard(((X1 + X3) * X2) = ((-X4 + (X1 + (X3 + X4))) * X2))).-step(add(rule(398, ((X1 * (X2 + X2)) + (((X1 + X1) * -X2) + X3)) = X3))).-step(hard(X1 = (-(X2 + X2) + (X1 + (X2 + X2))))).-step(hard(((X1 * X2) + X3) = ((X1 * (-X4 + (X2 + X4))) + X3))).-step(add(rule(399, ((X1 * (X2 + X2)) + (X3 + ((X1 + X1) * -X2))) = X3))).-step(add(rule(400, (((X1 + X1) * X2) + ((X1 * -(X2 + X2)) + X3)) = X3))).-step(hard(X1 = (-X2 + (X1 + X2)))).-step(add(rule(401, (((X1 + X1) * X2) + (X3 + (X1 * -(X2 + X2)))) = X3))).-step(add(rule(402, (X1 + ((X2 + ((X1 * -X1) + X3)) * X1)) = ((X3 + X2) * X1)))).-step(hard(((X1 + (-X2 + (X3 + X2))) * X4) = ((X1 + X3) * X4))).-step(add(rule(403, (X1 + ((X2 + (X3 + (X1 * -X1))) * X1)) = ((X2 + X3) * X1)))).-step(interreduce).-step(delete(rule(124, ((X1 + (X1 + (X1 + X1))) * X2) = (X1 * (X2 + (X2 + (X2 + X2))))))).-step(delete(rule(176, (X1 * ((X1 + X1) * (X1 + X1))) = (X1 + (X1 + (X1 + X1)))))).-step(delete(rule(188, ((X1 + (X1 + X1)) * -X2) = (X1 * -(X2 + (X2 + X2)))))).-step(add(rule(404, ((X1 + (X1 + X1)) * -X2) = (X1 * (X2 + (X2 + X2)))))).-step(delete(rule(192, ((X1 + X1) * (X2 + (X2 + (X2 + X2)))) = (X1 * (X2 + X2))))).-step(delete(rule(262, ((X1 + X1) * (X2 + (X2 + X2))) = ((X1 + (X1 + X1)) * (X2 + X2))))).-step(delete(rule(271, ((X1 + X1) * (X2 + X2)) = (X1 * ((X1 + X1) * ((X1 + X1) * X2)))))).-step(add(rule(405, (X1 * -(X2 + X2)) = (X1 * ((X1 + X1) * ((X1 + X1) * X2)))))).-step(delete(rule(272, ((X1 + X1) * ((X1 + X1) * (X2 + X2))) = (X1 * ((X1 + X1) * X2))))).-step(delete(rule(367, (X1 * ((X1 + X1) * -(X1 + X1))) = -(X1 + (X1 + (X1 + X1)))))).-step(delete(rule(368, ((X1 + X1) * (X1 + (X1 + X1))) = 0))).-step(delete(rule(370, ((X1 + X1) * -(X1 + (X1 + X1))) = 0))).-step(delete(rule(371, ((X1 + (X1 + X1)) * ((X1 + X1) * -X2)) = 0))).-step(delete(rule(372, ((X1 + (X1 + X1)) * -(X1 + (X1 + (X1 + X1)))) = 0))).-step(delete(rule(373, ((X1 + X1) * ((X1 + (X1 + X1)) * -X2)) = 0))).-step(delete(rule(375, ((X1 + (X1 + (X1 + X1))) * (X1 + (X1 + X1))) = 0))).-step(delete(rule(377, ((X1 + (X1 + X1)) * (X1 + (X1 + (X1 + X1)))) = 0))).-step(delete(rule(387, -(X1 + (X1 + (X1 + X1))) = (X1 + X1)))).-step(add(rule(406, ((X1 + (X1 + X1)) * -(X2 + X2)) = 0))).-step(add(rule(407, ((X1 + (X1 + X1)) * (X1 * -(X1 + X1))) = 0))).-step(add(rule(408, ((X1 + X1) * (X2 * (X3 + (X3 + X3)))) = 0))).-step(add(rule(409, ((X1 + X1) * ((X2 + (X2 + X2)) * X3)) = 0))).-step(add(rule(410, ((X1 + (X1 + X1)) * -X2) = ((X1 + (X1 + X1)) * X2)))).-step(add(rule(411, ((X1 + (X1 + X1)) * (X2 * -(X3 + X3))) = 0))).-step(add(rule(412, ((X1 + X1) * ((X1 + X1) * X2)) = (X1 * (X1 * -(X2 + X2)))))).-step(add(rule(413, (X1 * ((X1 + X1) * ((X1 + X1) * X2))) = ((X1 + X1) * -X2)))).-step(add(rule(414, (X1 + ((X2 + X2) * (X3 * X1))) = (X1 + (X2 * ((X3 + X3) * X1)))))).-step(add(rule(415, (X1 + (X2 * ((X3 + X3) * X4))) = ((X2 * (X3 * (X4 + X4))) + X1)))).-step(add(rule(416, (X1 + ((X2 + X2) * (X3 * X4))) = ((X2 * (X3 * (X4 + X4))) + X1)))).-step(add(rule(417, (X1 + ((X2 + X2) * (X3 * X4))) = ((X2 * ((X3 + X3) * X4)) + X1)))).-step(add(rule(418, (X1 + (X2 + ((X3 + X3) * X4))) = (X1 + ((X3 * (X4 + X4)) + X2))))).-step(add(rule(419, ((X1 + (X1 + X1)) * ((X2 + X2) * X3)) = 0))).-step(add(rule(420, ((X1 + (X1 + X1)) * (X2 * (X3 + X3))) = 0))).-step(add(rule(421, ((X1 * (X2 + X2)) + (X3 + X4)) = (X3 + (X4 + ((X1 + X1) * X2)))))).-step(add(rule(422, (X1 * (X2 * -(X3 + X3))) = ((X1 + X1) * ((X2 + X2) * X3))))).-step(add(rule(423, (X1 + (X1 + (X2 + (X1 + X1)))) = (X2 + -(X1 + X1))))).-step(add(rule(424, ((X1 + X1) * (X2 * (X3 + X3))) = (X1 * (X2 * -(X3 + X3)))))).-step(add(rule(425, (X1 + (X1 + (X1 + (X1 + X2)))) = (-(X1 + X1) + X2)))).-step(add(rule(426, (X1 * ((X2 * (X3 + X3)) + X4)) = (X1 * (X4 + ((X2 + X2) * X3)))))).-step(add(rule(427, (X1 + (X2 + ((X3 + X3) * X4))) = (X2 + ((X3 * (X4 + X4)) + X1))))).-step(add(rule(428, (X1 + (X2 + (X3 * (X4 + X4)))) = (X1 + (X2 + ((X3 + X3) * X4)))))).-step(add(rule(429, (X1 + (X2 * (X3 * (X4 + X4)))) = (X1 + (X2 * ((X3 + X3) * X4)))))).-step(add(rule(430, (X1 + (X2 * (X3 * (X4 + X4)))) = (X1 + ((X2 + X2) * (X3 * X4)))))).-step(hard((X1 + (X2 + ((X3 + X3) * X4))) = (X2 + (X1 + (X3 * (X4 + X4)))))).-step(add(rule(431, (X1 + ((X2 + X2) * (X3 * X4))) = (X1 + (X2 * ((X3 + X3) * X4)))))).-step(add(rule(432, (X1 + (X2 * (X3 * (X4 + X4)))) = ((X2 * ((X3 + X3) * X4)) + X1)))).-step(add(rule(433, (X1 + (X2 * (X3 * (X4 + X4)))) = (((X2 + X2) * (X3 * X4)) + X1)))).-step(add(rule(434, (X1 + (X2 + (X3 * (X4 + X4)))) = (X1 + (((X3 + X3) * X4) + X2))))).-step(add(rule(435, (((X1 + X1) * X2) + (X3 + X4)) = (X3 + (X4 + (X1 * (X2 + X2))))))).-step(add(rule(436, (X1 * (((X2 + X2) * X3) + X4)) = (X1 * (X4 + (X2 * (X3 + X3))))))).-step(add(rule(437, (((X1 + X1) * (X2 * X3)) + X4) = (X4 + (X1 * ((X2 + X2) * X3)))))).-step(add(rule(438, (X1 + (X2 + (X3 * (X4 + X4)))) = (X2 + (((X3 + X3) * X4) + X1))))).-step(add(rule(439, ((X1 * (X2 + X2)) + ((-X1 + X3) * X2)) = ((X1 + X3) * X2)))).-step(hard(((X1 + (X4 + X2)) * X3) = ((X1 + (X2 + X4)) * X3))).-step(hard(((X1 + X2) * X3) = ((-X1 + (X2 + (X1 + X1))) * X3))).-step(add(rule(440, ((X1 * (X2 + X2)) + ((X3 + -X1) * X2)) = ((X1 + X3) * X2)))).-step(add(rule(441, ((X1 + (X1 + X1)) * (X2 * X3)) = (X1 * ((X2 + (X2 + X2)) * X3))))).-step(add(rule(442, ((X1 + (X1 * (X2 * (X2 + X2)))) * (X2 + X2)) = 0))).-step(add(rule(443, (X1 * (X2 * (X3 + (X3 + X3)))) = (X1 * ((X2 + (X2 + X2)) * X3))))).-step(add(rule(444, (X1 * (X2 * (X3 + (X3 + X3)))) = ((X1 + (X1 + X1)) * (X2 * X3))))).-step(add(rule(445, ((X1 + X1) * (X2 + (X1 * ((X1 + X1) * X2)))) = 0))).-step(add(rule(446, (((X1 + X1) * X2) + (X1 * (-X2 + X3))) = (X1 * (X2 + X3))))).-step(hard((X1 * (X2 * (X4 + X3))) = (X1 * (X2 * (X3 + X4))))).-step(hard((X1 * (X2 + X3)) = (X1 * (-X2 + (X3 + (X2 + X2)))))).-step(add(rule(447, (X1 * (X2 + (X2 * (X1 * X1)))) = ((X1 + X1) * X2)))).-step(hard((X1 * (X1 * -(X1 + X2))) = (X1 * (X1 * -(X2 + X1))))).-step(add(rule(448, (((X1 + X1) * X2) + (X1 * (X3 + -X2))) = (X1 * (X2 + X3))))).-step(add(rule(449, ((X1 + ((X2 + X2) * X3)) * X4) = (((X2 * (X3 + X3)) + X1) * X4)))).-step(add(rule(450, ((X1 + (X2 * (X3 + X3))) * X4) = ((((X2 + X2) * X3) + X1) * X4)))).-step(hard((X1 * (X3 + (X1 * (-X2 + (X1 + X2))))) = (X1 + (X1 * X3)))).-step(add(rule(451, ((X1 + (((X1 * -X2) + X3) * X2)) * X2) = (X3 * (X2 * X2))))).-step(hard((X1 * X2) = ((-X2 + (X1 + X2)) * X2))).-step(add(rule(452, (X1 * (X1 * (X2 * X1))) = (X2 * X1)))).-step(add(rule(453, ((X1 + ((X2 + (X1 * -X3)) * X3)) * X3) = (X2 * (X3 * X3))))).-step(add(rule(454, (X1 * (X1 * (X1 + (X2 * X1)))) = (X1 + (X2 * X1))))).-step(hard((((X1 * (X1 + X2)) + X3) * X1) = (((X1 * (X2 + X1)) + X3) * X1))).-step(hard((X1 + (X2 * ((X3 + X4) * X1))) = (X1 + (X2 * ((X4 + X3) * X1))))).-step(add(rule(455, (X1 * (X3 + (X1 * (X2 * X3)))) = (X1 * (X1 * ((X2 + X1) * X3)))))).-step(hard((X1 + (X2 + (X3 + (X4 + X5)))) = (X3 + (X5 + (X4 + (X1 + X2)))))).-step(interreduce).-step(delete(rule(112, ((X1 + (X1 + X1)) * (X1 * X1)) = (X1 + (X1 + X1))))).-step(delete(rule(209, (X1 + (X1 * ((X2 + X2) * X3))) = (X1 + (X1 * (X2 * (X3 + X3))))))).-step(delete(rule(323, (X1 + (X2 * (X3 * (X1 + X1)))) = (X1 + ((X2 + X2) * (X3 * X1)))))).-step(delete(rule(325, (X1 + (X2 * (X3 * (X1 + X1)))) = (X1 + (X2 * ((X3 + X3) * X1)))))).-step(delete(rule(369, ((X1 + (X1 + X1)) * -(X1 + X1)) = 0))).-step(delete(rule(374, ((X1 + X1) * ((X1 + (X1 + X1)) * X2)) = 0))).-step(delete(rule(376, ((X1 + (X1 + X1)) * ((X1 + X1) * X2)) = 0))).-step(delete(rule(378, ((X1 + X1) * (X2 * (X1 + (X1 + X1)))) = 0))).-step(delete(rule(379, ((X1 + (X1 + X1)) * (X2 * (X1 + X1))) = 0))).-step(delete(rule(404, ((X1 + (X1 + X1)) * -X2) = (X1 * (X2 + (X2 + X2)))))).-step(delete(rule(405, (X1 * -(X2 + X2)) = (X1 * ((X1 + X1) * ((X1 + X1) * X2)))))).-step(delete(rule(406, ((X1 + (X1 + X1)) * -(X2 + X2)) = 0))).-step(delete(rule(407, ((X1 + (X1 + X1)) * (X1 * -(X1 + X1))) = 0))).-step(delete(rule(412, ((X1 + X1) * ((X1 + X1) * X2)) = (X1 * (X1 * -(X2 + X2)))))).-step(delete(rule(414, (X1 + ((X2 + X2) * (X3 * X1))) = (X1 + (X2 * ((X3 + X3) * X1)))))).-step(delete(rule(423, (X1 + (X1 + (X2 + (X1 + X1)))) = (X2 + -(X1 + X1))))).-step(hard((X1 + (X2 + (X3 + (X4 + X5)))) = (X2 + (X4 + (X5 + (X3 + X1)))))).-step(hard((X1 + (X2 + (X3 + (X4 + X5)))) = (X3 + (X4 + (X5 + (X1 + X2)))))).-step(add(rule(456, ((X1 + X1) * ((X1 * (X1 + X1)) + X2)) = (-(X1 + X1) + ((X1 + X1) * X2))))).-step(hard((X1 * ((X2 + (X4 + X4)) * X3)) = (X1 * ((X4 + (X4 + X2)) * X3)))).-step(hard((X1 * (X2 * (X3 + (X4 + X4)))) = (X1 * (X2 * (X4 + (X4 + X3)))))).-step(hard((X1 + ((X1 * (X1 * X2)) + X3)) = (X3 + (X1 * (X1 * (X1 + X2)))))).-step(add(rule(457, ((X1 * (X1 * (X2 + X1))) + X3) = (X1 + ((X1 * (X1 * X2)) + X3))))).-step(add(rule(458, (X1 + (X2 + (X1 * (X1 * X3)))) = (X2 + (X1 * (X1 * (X3 + X1))))))).-step(hard((X1 + -(X2 + X2)) = (X2 + (X1 + (X2 + (X2 + X2)))))).-step(hard((X1 + (X1 + (X2 + (X1 + X1)))) = (X2 + -(X1 + X1)))).-step(hard((X1 * (X2 + (X1 * (X3 + X1)))) = (X1 * (X2 + (X1 * (X1 + X3)))))).-step(hard((X1 + (X1 * ((X1 + X1) * X2))) = (X1 * (X1 * (X2 + (X1 + X2)))))).-step(hard((X1 + ((X1 * (X2 * X1)) + X3)) = (X3 + (X1 * ((X1 + X2) * X1))))).-step(add(rule(459, ((X1 * ((X2 + X1) * X1)) + X3) = (X1 + ((X1 * (X2 * X1)) + X3))))).-step(add(rule(460, (X1 + (X2 + (X1 * (X3 * X1)))) = (X2 + (X1 * ((X3 + X1) * X1)))))).-step(hard((X1 * (X2 + ((X3 + X1) * X1))) = (X1 * (X2 + ((X1 + X3) * X1))))).-step(hard((X1 + (X1 * (X2 * (X1 + X1)))) = (X1 * ((X2 + (X1 + X2)) * X1)))).-step(add(rule(461, ((X4 * -X2) + (X3 + ((X1 + X4) * X2))) = ((X1 * X2) + X3)))).-step(hard(((X1 + X3) * X2) = ((-X4 + (X3 + (X1 + X4))) * X2))).-step(hard(((X1 * X2) + X3) = (-X2 + (X3 + (X2 + (X1 * X2)))))).-step(hard(((X1 * X2) + X3) = (X3 + ((-X5 + (X1 + X5)) * X2)))).-step(hard(((-X3 + X1) * X2) = ((-(X4 + X3) + (X1 + X4)) * X2))).-step(add(rule(462, (X1 + (((X2 + X2) * X3) + X4)) = ((X2 * (X3 + X3)) + (X4 + X1))))).-step(hard(((X1 * (X2 + X2)) + (X3 + X4)) = (((X1 + X1) * X2) + (X4 + X3)))).-step(hard((((X1 * (X1 + X2)) + X3) * X1) = ((X3 + (X1 * (X2 + X1))) * X1))).-step(hard(((((X1 + X2) * X1) + X3) * X1) = ((X3 + ((X2 + X1) * X1)) * X1))).-step(add(rule(463, (X1 * (X1 * ((X1 + X2) * X2))) = (X1 * ((X2 + X1) * (X2 * X2)))))).-step(add(rule(464, (X1 * ((X1 + X2) * (X1 * X2))) = (X1 * (X2 * ((X2 + X1) * X2)))))).-step(add(rule(465, ((X1 + (X1 * (X2 * X3))) * X2) = (X1 * (X2 * ((X2 + X3) * X2)))))).-step(add(rule(466, (X1 * (X2 + (X3 * (X2 + X2)))) = (X1 * ((X3 + (X1 * (X1 + (X1 * X3)))) * X2))))).-step(add(rule(467, (X1 * ((X2 + X1) * (X1 * X2))) = (X1 * (X2 * ((X2 + X1) * X2)))))).-step(hard(((X1 * X2) + ((X3 + X1) * X4)) = ((X1 * (X4 + X2)) + (X3 * X4)))).-step(add(rule(468, ((X1 * X2) + ((X3 + X1) * X4)) = ((X3 * X4) + (X1 * (X2 + X4)))))).-step(interreduce).-step(delete(rule(235, ((X1 * X2) + (X3 * (X4 + X2))) = (((X3 + X1) * X2) + (X3 * X4))))).-step(delete(rule(256, ((X1 * (X2 + X3)) + (X4 * X3)) = ((X1 * X2) + ((X4 + X1) * X3))))).-step(delete(rule(258, (((X1 + X2) * X3) + (X2 * X4)) = ((X1 * X3) + (X2 * (X4 + X3)))))).-step(hard((X1 * ((X2 + (X4 + X4)) * X3)) = (X1 * ((X4 + (X2 + X4)) * X3)))).-step(add(rule(469, ((X1 * X2) + (X3 * (X2 + X4))) = ((X3 * X4) + ((X3 + X1) * X2))))).-step(hard((X1 * (X1 * (X2 + (X3 + X1)))) = (X1 * (X1 * (X1 + (X2 + X3)))))).-step(add(rule(470, (X1 * (X2 + (X1 * (X2 + X1)))) = (X1 + ((X1 + (X1 * X1)) * X2))))).-step(hard((X1 * ((X2 + (X3 + X1)) * X1)) = (X1 * ((X1 + (X2 + X3)) * X1)))).-step(add(rule(471, ((X1 + (X2 + (X2 * X2))) * (X2 * X2)) = ((X2 + ((X1 + X2) * X2)) * X2)))).-step(hard(((X1 * X2) + (X3 * (X4 + X2))) = (((X3 + X1) * X2) + (X3 * X4)))).-step(hard((X1 * (X2 * (X3 + (X4 + X4)))) = (X1 * (X2 * (X4 + (X3 + X4)))))).-step(hard(((X1 * (X2 * X2)) + (X3 + X2)) = (X3 + ((X1 + X2) * (X2 * X2))))).-step(hard(((X1 * (X2 * X1)) + (X3 + X1)) = (X3 + (X1 * ((X1 + X2) * X1))))).-step(add(rule(472, ((X1 + ((X1 + X2) * X2)) * X2) = (X2 + (X1 * (X2 + (X2 * X2))))))).-step(add(rule(473, (X1 * (X1 * (X1 + (X1 + (X1 * (X2 + X2)))))) = ((X1 + X1) * (X2 + (X1 * X1)))))).-step(add(rule(474, (X1 * ((X1 + X2) * (X2 * X2))) = (X1 * (X1 * ((X1 + X2) * X2)))))).-step(hard(((X1 * (X2 + X3)) + (X4 * X2)) = (((X1 + X4) * X2) + (X1 * X3)))).-step(add(rule(475, ((X1 + (X1 * X1)) * (X1 + X1)) = ((X1 + X1) * (X1 + (X1 * X1)))))).-step(hard((X1 + (X2 + (X3 + (X4 + X5)))) = (X2 + (X3 + (X5 + (X4 + X1)))))).-step(hard((X3 + (X4 + (X5 + (X6 + X2)))) = (X3 + (X5 + (X6 + (X4 + X2)))))).-step(hard((X3 + (X4 + (X5 + (X6 + X2)))) = (X3 + (X4 + (X6 + (X5 + X2)))))).-step(add(rule(476, (X1 + (X1 + ((X2 + X2) * X1))) = ((X2 + (X1 * X1)) * (X1 + X1))))).-step(hard(((X1 * (X2 + (X2 + X3))) + X4) = ((X1 * (X3 + (X2 + X2))) + X4))).-step(hard((((X1 + X1) * X2) + (X3 + X4)) = (X4 + (X3 + (X1 * (X2 + X2)))))).-step(add(rule(477, (X1 + ((X2 * (X3 + X3)) + X4)) = (X4 + (((X2 + X2) * X3) + X1))))).-step(add(rule(478, (((X1 + (X1 + X1)) * X2) + X3) = (X3 + (X1 * (X2 + (X2 + X2))))))).-step(add(rule(479, (X1 + (X2 * (X3 + (X3 + X3)))) = (X1 + ((X2 + (X2 + X2)) * X3))))).-step(add(rule(480, ((X1 * (X2 + (X2 + X2))) + X3) = (X3 + ((X1 + (X1 + X1)) * X2))))).-step(hard(((X1 * (X2 + (X3 + X3))) + X4) = (X4 + (X1 * (X3 + (X3 + X2)))))).-step(add(rule(481, ((X1 * (X2 + (X3 * X2))) + X4) = (X4 + ((X1 + (X1 * X3)) * X2))))).-step(add(rule(482, (((X1 + (X1 * X2)) * X3) + X4) = (X4 + (X1 * (X3 + (X2 * X3))))))).-step(hard((((X1 + (X1 + X2)) * X3) + X4) = (((X2 + (X1 + X1)) * X3) + X4))).-step(hard((((X1 + (X2 + X2)) * X3) + X4) = (X4 + ((X2 + (X2 + X1)) * X3)))).-step(hard(((X3 + (X1 * (X4 + X2))) * X5) = ((X3 + (X1 * (X2 + X4))) * X5))).-step(hard(((X1 + (X1 + (X2 + X3))) * X4) = ((X2 + (X1 + (X1 + X3))) * X4))).-step(hard((((X1 * (X2 + X3)) + X4) * X5) = (((X1 * (X3 + X2)) + X4) * X5))).-step(add(rule(483, ((X1 + (X1 * X2)) * (X1 + X1)) = ((X1 + X1) * (X1 + (X2 * X1)))))).-step(add(rule(484, ((X1 + (X1 * X3)) * (X2 + X2)) = ((X1 + X1) * (X2 + (X3 * X2)))))).-step(add(rule(485, ((X1 + (X2 + (X3 * X3))) * (X3 * X3)) = ((X3 + ((X1 + X2) * X3)) * X3)))).-step(hard((X1 + (X1 * (X3 + (X4 + X2)))) = (X1 + (X1 * (X4 + (X3 + X2)))))).-step(hard((X1 * (X1 * (X3 + (X1 + X2)))) = (X1 * (X1 * (X1 + (X3 + X2)))))).-step(hard((X1 * ((X3 + (X1 + X2)) * X1)) = (X1 * ((X1 + (X3 + X2)) * X1)))).-step(hard((X1 * (((X2 + X1) * X1) + X3)) = (X1 * (((X1 + X2) * X1) + X3)))).-step(hard((X1 + (X4 + ((X5 + X2) * X3))) = (X4 + (((X2 + X5) * X3) + X1)))).-step(add(rule(486, ((X1 + X1) * (X2 + (X1 * (X1 + (X1 + X1))))) = ((X1 + X1) * X2)))).-step(interreduce).-step(delete(rule(252, ((X1 + (X2 + (X1 * X1))) * (X1 * X1)) = ((X1 + ((X2 + X1) * X1)) * X1)))).-step(delete(rule(313, ((X1 + (X1 * (X2 * -X2))) * (X2 + X2)) = 0))).-step(delete(rule(442, ((X1 + (X1 * (X2 * (X2 + X2)))) * (X2 + X2)) = 0))).-step(delete(rule(471, ((X1 + (X2 + (X2 * X2))) * (X2 * X2)) = ((X2 + ((X1 + X2) * X2)) * X2)))).-step(delete(rule(475, ((X1 + (X1 * X1)) * (X1 + X1)) = ((X1 + X1) * (X1 + (X1 * X1)))))).-step(delete(rule(483, ((X1 + (X1 * X2)) * (X1 + X1)) = ((X1 + X1) * (X1 + (X2 * X1)))))).-step(add(rule(487, ((X1 + X1) * (X2 * (X3 * (X1 + (X1 + X1))))) = 0))).-step(add(rule(488, (((X1 * (X1 + (X1 + X1))) + X2) * (X1 + X1)) = (X2 * (X1 + X1))))).-step(add(rule(489, ((X2 + (X1 * (X1 + (X1 + X1)))) * (X1 + X1)) = (X2 * (X1 + X1))))).-step(add(rule(490, (X1 * (X2 + X2)) = ((X1 + X1) * (? + (? + (? + X2))))))).-step(add(rule(491, ((X1 + X1) * (X3 + (X3 + (X3 + X2)))) = ((X1 + X1) * (? + (? + (? + X2))))))).-step(add(rule(492, (X1 * (X2 + X2)) = ((X1 + X1) * (X2 + (? + (? + ?))))))).-step(add(rule(493, ((X1 + X1) * (X2 + (X3 + (X3 + X3)))) = ((X1 + X1) * (X2 + (? + (? + ?))))))).-step(hard((X2 + ((X1 + (X3 + X4)) * X2)) = (X2 + ((X4 + (X3 + X1)) * X2)))).-step(hard(((X2 + X3) * ((X1 + X1) * X4)) = ((X3 + X2) * (X1 * (X4 + X4))))).-step(hard((X1 * ((X3 + X4) * (X2 + X2))) = ((X1 + X1) * ((X4 + X3) * X2)))).-step(hard((X3 + ((X4 + (X5 + X2)) * X3)) = (X3 + ((X5 + (X4 + X2)) * X3)))).-step(add(rule(494, ((X1 + ((X1 * (X2 * -X2)) + X3)) * X2) = (X3 * X2)))).-step(add(rule(495, ((X1 + (-X2 + X3)) * X4) = ((X3 + (-X2 + X1)) * X4)))).-step(hard(((X1 + (X2 + X3)) * X4) = ((X3 + (X2 + X1)) * X4))).-step(add(rule(496, ((X1 + (X2 + (X1 * (X3 * -X3)))) * X3) = (X2 * X3)))).-step(hard((X1 + X2) = (-X4 + (X2 + (X1 + X4))))).-step(hard((X1 + X2) = (-X5 + (X2 + (X1 + X5))))).-step(add(rule(497, ((X1 + (X2 + (X2 * (X3 * -X3)))) * X3) = (X1 * X3)))).-step(add(rule(498, (X1 * (X2 + (X2 * (X1 * (X2 * (X1 * -X2)))))) = 0))).-step(add(rule(499, (X1 * (X2 + ((X2 * (X1 * -X1)) + X3))) = (X1 * X3)))).-step(add(rule(500, (X1 * (X2 * (X1 * X1))) = (X1 * X2)))).-step(add(rule(501, (X1 * (X2 * (X1 * -X1))) = (X1 * -X2)))).-step(add(rule(502, (X1 * ((X2 * (X1 * X1)) + X3)) = (X1 * (X2 + X3))))).-step(add(rule(503, (X1 * (X2 + (X3 * (X1 * X1)))) = (X1 * (X3 + X2))))).-step(add(rule(504, (X1 * (X2 * (X1 * (X1 + X1)))) = (X1 * (X2 + X2))))).-step(add(rule(505, (X1 * (X2 * (X1 * X2))) = (X1 * (X2 * (X2 * X1)))))).-step(add(rule(506, (X1 * (X2 + (-X3 + X4))) = (X1 * (X4 + (-X3 + X2)))))).-step(hard((X1 * (X2 + (X3 + X4))) = (X1 * (X4 + (X3 + X2))))).-step(add(rule(507, (X1 * (X2 + (X3 + (X3 * (X1 * -X1))))) = (X1 * X2)))).-step(add(rule(508, (X1 * (-X2 + (X1 * ((X1 + X1) * X2)))) = (X1 * X2)))).-step(add(rule(509, ((-X1 + (X1 * (X2 * (X2 + X2)))) * X2) = (X1 * X2)))).-step(add(rule(510, ((X5 * -X4) + (X2 + (X1 + (X5 * X4)))) = (X1 + X2)))).-step(hard((X1 + X2) = (-(X3 + X3) + (X2 + (X1 + (X3 + X3)))))).-step(add(rule(511, (X1 * (X1 * (X2 * -X1))) = (X2 * -X1)))).-step(add(rule(512, (X3 * (X2 * X2)) = (X2 * (X2 * X3))))).-step(hard(((X1 + X1) * (X2 + X1)) = (X1 * (X1 + (X2 + (X1 + X2)))))).-step(hard((-X1 + (X2 + (X1 + (X3 + X4)))) = (X3 + (X4 + X2)))).-step(hard((X1 + (X2 * X3)) = (X1 + ((-X4 + (X2 + X4)) * X3)))).-step(hard((-X1 + (X2 + (X3 + (X1 + X4)))) = (X3 + (X2 + X4)))).-step(hard((-X1 + (X2 + (X3 + (X4 + X1)))) = (X4 + (X2 + X3)))).-step(hard((X1 + (X2 + X3)) = (-X4 + (X2 + (X1 + (X4 + X3)))))).-step(hard((-X1 + (X4 + (X1 + (X3 + X5)))) = (X4 + (X5 + X3)))).-step(hard((X1 + (X2 + X3)) = (-X4 + (X2 + (X3 + (X1 + X4)))))).-step(hard((X1 + (X2 + (-X5 + (X4 + X5)))) = (X4 + (X1 + X2)))).-step(hard(((X1 * X2) + X3) = (X3 + ((-X6 + (X1 + X6)) * X2)))).-step(hard(((X1 + X3) * X2) = ((-X4 + (X3 + (X4 + X1))) * X2))).-step(add(rule(513, (-? + (((X2 + X2) * X3) + ?)) = (X2 * (X3 + X3))))).-step(add(rule(514, (-X1 + (((X2 + X2) * X3) + X1)) = (-? + (((X2 + X2) * X3) + ?))))).-step(add(rule(515, ((X1 + (X2 * (X2 * X1))) * X2) = (X1 * (X2 + X2))))).-step(hard((X1 * (X2 * X2)) = (X2 * (X2 * (-X2 + (X1 + X2)))))).-step(add(rule(516, ((X2 + (X1 * (X1 + (X1 * -X2)))) * X1) = X1))).-step(interreduce).-step(delete(rule(30, (X1 + (X2 * (X1 * X1))) = ((X1 + X2) * (X1 * X1))))).-step(add(rule(517, (X1 + (X2 * (X1 * X1))) = (X1 * (X1 * (X1 + X2)))))).-step(delete(rule(108, ((X1 + (X2 * X3)) * (X3 * X3)) = (((X1 * X3) + X2) * X3)))).-step(add(rule(518, (X3 * (X3 * (X1 + (X2 * X3)))) = (((X1 * X3) + X2) * X3)))).-step(delete(rule(127, (((X1 + X2) * (X1 * X1)) + X3) = (X1 + ((X2 * (X1 * X1)) + X3))))).-step(delete(rule(128, (X1 + (X2 * (X3 * (X1 * X1)))) = ((X1 + (X2 * X3)) * (X1 * X1))))).-step(add(rule(519, (X1 + (X2 * (X3 * (X1 * X1)))) = (X1 * (X1 * (X1 + (X2 * X3))))))).-step(delete(rule(129, (X1 + (X2 + (X3 * (X1 * X1)))) = (X2 + ((X1 + X3) * (X1 * X1)))))).-step(delete(rule(131, ((X1 + (X2 + X2)) * (X1 * X1)) = (X1 + (X2 * (X1 * (X1 + X1))))))).-step(add(rule(520, (X1 * (X1 * (X1 + (X2 + X2)))) = (X1 + (X2 * (X1 * (X1 + X1))))))).-step(delete(rule(136, (((X1 + X2) * (X2 * X2)) + X3) = (X2 + ((X1 * (X2 * X2)) + X3))))).-step(delete(rule(138, (((X1 * X2) + X3) * (X2 * X2)) = ((X1 + (X3 * X2)) * X2)))).-step(add(rule(521, (X2 * (X2 * ((X1 * X2) + X3))) = ((X1 + (X3 * X2)) * X2)))).-step(delete(rule(238, (X1 + ((X2 + X3) * (X3 * X3))) = (X3 + (X1 + (X2 * (X3 * X3))))))).-step(add(rule(522, (X1 + (X3 * (X3 * (X2 + X3)))) = (X3 + (X1 + (X2 * (X3 * X3))))))).-step(delete(rule(239, (X1 + ((X2 + X3) * (X2 * X2))) = ((X3 * (X2 * X2)) + (X1 + X2))))).-step(add(rule(523, (X1 + (X2 * (X2 * (X2 + X3)))) = ((X3 * (X2 * X2)) + (X1 + X2))))).-step(delete(rule(250, ((X1 + ((X1 * X1) + X2)) * (X1 * X1)) = ((X1 + ((X2 + X1) * X1)) * X1)))).-step(add(rule(524, ((X1 + ((X2 + X1) * X1)) * X1) = (X1 * (X1 + (X1 * (X2 + X1))))))).-step(delete(rule(251, ((X1 + (X1 * (X2 * X3))) * X3) = (X1 * ((X2 + X3) * (X3 * X3)))))).-step(add(rule(525, ((X1 + (X1 * (X2 * X3))) * X3) = (X1 * (X3 * (X3 * (X2 + X3))))))).-step(delete(rule(259, ((X1 + (X1 * (X2 * X3))) * X3) = (X1 * ((X3 + X2) * (X3 * X3)))))).-step(add(rule(526, ((X1 + (X1 * (X2 * X3))) * X3) = (X1 * (X3 * (X3 * (X3 + X2))))))).-step(delete(rule(334, (X2 + (X1 * (X2 * -X2))) = ((-X1 + X2) * (X2 * X2))))).-step(add(rule(527, (X2 + (X1 * (X2 * -X2))) = (X2 * (X2 * (-X1 + X2)))))).-step(delete(rule(346, (-X1 + (X2 * (X1 * X1))) = ((-X1 + X2) * (X1 * X1))))).-step(add(rule(528, (-X1 + (X2 * (X1 * X1))) = (X1 * (X1 * (-X1 + X2)))))).-step(delete(rule(356, ((X1 + (X2 * (X3 * X1))) * (X1 * X1)) = (X1 + (X2 * (X3 * X1)))))).-step(add(rule(529, (X1 * (X1 * (X1 + (X2 * (X3 * X1))))) = (X1 + (X2 * (X3 * X1)))))).-step(delete(rule(359, ((-X1 + X2) * (X1 * -X1)) = ((-X2 + X1) * (X1 * X1))))).-step(add(rule(530, ((-X1 + X2) * (X1 * -X1)) = (X1 * (X1 * (-X2 + X1)))))).-step(delete(rule(447, (X1 * (X2 + (X2 * (X1 * X1)))) = ((X1 + X1) * X2)))).-step(delete(rule(454, (X1 * (X1 * (X1 + (X2 * X1)))) = (X1 + (X2 * X1))))).-step(delete(rule(458, (X1 + (X2 + (X1 * (X1 * X3)))) = (X2 + (X1 * (X1 * (X3 + X1))))))).-step(delete(rule(463, (X1 * (X1 * ((X1 + X2) * X2))) = (X1 * ((X2 + X1) * (X2 * X2)))))).-step(add(rule(531, (X1 * (X1 * ((X1 + X2) * X2))) = (X1 * (X2 * (X2 * (X2 + X1))))))).-step(delete(rule(474, (X1 * ((X1 + X2) * (X2 * X2))) = (X1 * (X1 * ((X1 + X2) * X2)))))).-step(add(rule(532, (X1 * (X2 * (X2 * (X1 + X2)))) = (X1 * (X1 * ((X1 + X2) * X2)))))).-step(delete(rule(485, ((X1 + (X2 + (X3 * X3))) * (X3 * X3)) = ((X3 + ((X1 + X2) * X3)) * X3)))).-step(add(rule(533, ((X3 + ((X1 + X2) * X3)) * X3) = (X3 * (X3 + (X3 * (X1 + X2))))))).-step(delete(rule(492, (X1 * (X2 + X2)) = ((X1 + X1) * (X2 + (? + (? + ?))))))).-step(delete(rule(493, ((X1 + X1) * (X2 + (X3 + (X3 + X3)))) = ((X1 + X1) * (X2 + (? + (? + ?))))))).-step(add(rule(534, ((X1 + X1) * (X2 + (X3 + (X3 + X3)))) = ((X1 + X1) * (? + (? + (? + X2))))))).-step(delete(rule(513, (-? + (((X2 + X2) * X3) + ?)) = (X2 * (X3 + X3))))).-step(delete(rule(514, (-X1 + (((X2 + X2) * X3) + X1)) = (-? + (((X2 + X2) * X3) + ?))))).-step(add(rule(535, (-X1 + (((X2 + X2) * X3) + X1)) = ((X2 + X2) * X3)))).-step(simplify_queue).-step(add(rule(536, (X1 * ((X1 + (X2 * X1)) * X1)) = (X1 + (X1 * X2))))).-step(add(rule(537, ((X2 + (X1 * X2)) * X2) = (X2 * (X2 + (X2 * X1)))))).-step(add(rule(538, (X1 * (X2 * (X3 * X3))) = (X3 * (X3 * (X1 * X2)))))).-step(add(rule(539, (X1 * (X2 * (X2 + X2))) = (X2 * (X2 * (X1 + X1)))))).-step(hard((X1 * X2) = (X1 * (-X1 + (X2 + X1))))).-step(add(rule(540, (X1 * (X2 * -X2)) = (X2 * (X2 * -X1))))).-step(add(rule(541, ((X1 + X1) * X2) = (X2 * (X2 * (X1 * (X2 + X2))))))).-step(add(rule(542, (X1 * (X1 * (X2 * X3))) = (X2 * (X1 * (X1 * X3)))))).-step(add(rule(543, (X2 * X1) = (X1 * X2)))).--lemma((X1 + 0) = X1).-lemma((X1 + (-X1 + X2)) = X2).-lemma(-(-X1) = X1).-lemma((X2 + (X1 + -X2)) = X1).-lemma((X1 * (X1 * (X1 * X2))) = (X1 * X2)).-lemma((X1 + (X2 + -(X1 + X2))) = 0).-lemma((X1 * ((X1 * X1) + X2)) = (X1 + (X1 * X2))).-lemma((X1 * 0) = 0).-lemma((-X1 * -(-X1 * -X1)) = X1).-lemma((X1 + (X1 * (X1 * X2))) = (X1 * (X1 * (X1 + X2)))).-lemma((0 * X1) = 0).-lemma(((X1 * (X2 * X4)) + (X3 * X4)) = (((X1 * X2) + X3) * X4)).-lemma(((X1 * X4) + (X2 * (X3 * X4))) = ((X1 + (X2 * X3)) * X4)).-lemma((X1 * (X2 * (X1 * (X2 * (X1 * X2))))) = (X1 * X2)).-lemma(-(X1 * X2) = (X1 * -X2)).-lemma((-X1 * X2) = (X1 * -X2)).-lemma(((X1 + (X1 * (X2 * -X2))) * (X2 * X3)) = 0).-lemma(((X1 + (((X1 * -X2) + X3) * X2)) * X2) = (X3 * (X2 * X2))).-lemma((X1 * (X1 * (X2 * X1))) = (X2 * X1)).-lemma((X1 * (X2 * (X1 * X1))) = (X1 * X2)).-lemma((X1 * (X2 * (X3 * X3))) = (X3 * (X3 * (X1 * X2)))).
− misc/static-libstdc++ 
@@ -1,24 +0,0 @@-#!/bin/zsh-typeset -a args--process() {-    for arg in $*; do-        case $arg in-            \"*\")-                process $(echo $arg | cut -c2- | rev | cut -c2- | rev)-                ;;-            @*)-                process $(cat $(echo $arg | cut -c2-))-                ;;-            -lstdc++ | -fuse-ld=gold)-                ;;-            *)-                args+=$arg-                ;;-        esac-    done-}--process $*--exec g++ -static-libgcc -static-libstdc++ $args
− misc/test.hs 
@@ -1,161 +0,0 @@-{-# LANGUAGE TemplateHaskell, FlexibleInstances, FlexibleContexts, UndecidableInstances, StandaloneDeriving, ScopedTypeVariables, TupleSections, DeriveGeneric #-}-import Twee.Constraints-import Twee.Term hiding (subst, canonicalise, F)-import Twee.Term.Core hiding (F)-import Test.QuickCheck hiding (Function, Fun)-import Test.QuickCheck.All-import Twee.Pretty-import Twee.CP-import Twee.Proof-import qualified Twee.KBO as Ord-import Text.PrettyPrint-import Twee.Base hiding (F)-import Twee.Rule-import Twee.Equation-import Control.Monad-import qualified Data.Map as Map-import Data.Maybe-import Data.Ord-import Data.List-import Data.Typeable-import qualified Twee.Index as Index-import Data.Int-import GHC.Generics--newtype Func = F Int deriving (Eq, Ord, Show)--instance Pretty Func where pPrint (F f) = text "f" <> int f-instance PrettyTerm Func-instance Arbitrary (Subst Func) where-  arbitrary = fmap fromJust (fmap listToSubst (liftM2 zip (fmap nub arbitrary) (infiniteListOf arbitrary)))-instance Arbitrary Func where-  arbitrary = F <$> choose (1, 1)-instance Minimal Func where-  minimal = fun (F 0)-instance Sized Func where size _ = 1-instance Arity Func where-  arity (F 0) = 0-  arity (F 1) = 2-instance Skolem Func-instance EqualsBonus Func--instance Arbitrary Var where arbitrary = fmap V (choose (0, 3))-instance (Ord f, Typeable f, Arbitrary f) => Arbitrary (Fun f) where-  arbitrary = fmap fun arbitrary--instance (Ord f, Typeable f, Arbitrary f, Sized f, Arity f) => Arbitrary (Term f) where-  arbitrary =-    sized $ \n ->-      oneof $-        [ build <$> var <$> arbitrary ] ++-        [ do { f <- arbitrary; build <$> app f <$> vectorOf (arity f) (resize ((n-1) `div` arity f) arbitrary :: Gen (Term f)) } | n > 0 ]-  shrink (App f ts0) =-    ts ++ (build <$> app f <$> shrinkOne ts)-    where-      ts = unpack ts0-      shrinkOne [] = []-      shrinkOne (x:xs) =-        [ y:xs | y <- shrink x ] ++-        [ x:ys | ys <- shrinkOne xs ]-  shrink _ = []--data Pair f = Pair (Term f) (Term f) deriving Show--instance (Ord f, Typeable f, Arbitrary f, Arity f, Sized f) => Arbitrary (Pair f) where-  arbitrary = liftM2 Pair arbitrary arbitrary-  shrink (Pair x y) =-    [ Pair x' y  | x' <- shrink x ] ++-    [ Pair x y'  | y' <- shrink y ] ++-    [ Pair x' y' | x' <- shrink x, y' <- shrink y ]--instance Ordered Func where-  lessIn = Ord.lessIn-  lessEq = Ord.lessEq--instance Function f => Arbitrary (Model f) where-  arbitrary = fmap (modelFromOrder . map Variable . nub) arbitrary-  shrink = weakenModel--prop_1 :: Model Func -> Pair Func -> Subst Func -> Property-prop_1 model (Pair t u) sub =-  counterexample ("Model: " ++ prettyShow model) $-  counterexample ("Subst: " ++ prettyShow sub) $-  conjoin $ do-    let cp = CriticalPair (t :=: u) 0 Nothing (axiom (Axiom 0 "dummy" (t :=: u)))-    r@(Rule _ t' u') <- map orient (map cp_eqn (split cp))-    return $-      counterexample ("LHS:   " ++ prettyShow t') $-      counterexample ("RHS:   " ++ prettyShow u') $-      counterexample ("Rule:  " ++ prettyShow r) $-      counterexample ("Inst:  " ++ prettyShow (Rule Oriented (subst sub t') (subst sub u'))) $-      counterexample ("Res:   " ++ show (lessIn model (subst sub u') (subst sub t'))) $-      not (reducesInModel model r sub) || isJust (lessIn model (subst sub u') (subst sub t'))--prop_2 :: Model Func -> Pair Func -> Bool-prop_2 model (Pair t u) =-  not (lessIn model t u == Just Strict && isJust (lessIn model u t))--prop_3 :: Pair Func -> Bool-prop_3 (Pair t u) =-  not (lessThan t u && lessEq u t)--prop_4 :: Pair Func -> Property-prop_4 (Pair t u) =-  t /= u ==> -  not (lessEq t u && lessEq u t)--prop_5 :: Term Func -> Property-prop_5 t =-  lessEq t t .&&. not (lessThan t t)--prop_paths :: Term Func -> Property-prop_paths t =-  forAllShrink (choose (0, len t-1)) shrink $ \n ->-    counterexample (show (positionToPath t n)) $-    pathToPosition t (positionToPath t n) === n--deriving instance Ord f => Ord (Subst f)--prop_index :: [Term Func] -> Term Func -> Property-prop_index ts u =-  counterexample (show ts) $-  counterexample (show idx) $-  sort (catMaybes [fmap (,t) (match t u) | t <- ts]) ===-  sort (Index.matches u idx)-  where-    idx = foldr (\t -> Index.insert t t) Index.empty ts--deriving instance Eq Symbol-deriving instance Generic Symbol--instance Arbitrary Symbol where-  arbitrary =-    Symbol <$>-      arbitrary <*>-      fmap getLarge arbitrary <*>-      (fmap (fromIntegral . getLarge) (arbitrary :: Gen (Large Int32)) `suchThat` (> 0) `suchThat` (< 2^31))-  shrink s =-    filter ok (genericShrink s)-    where-      ok s = Twee.Term.Core.size s > 0--prop_symbol_1 :: Symbol -> Property-prop_symbol_1 s =-  withMaxSuccess 100000 $-  counterexample ("fun/index/size = " ++ show (isFun s, index s, Twee.Term.Core.size s)) $-  counterexample ("n = " ++ show (fromSymbol s)) $-  toSymbol (fromSymbol s) === twiddle s-  where-    twiddle s =-      s { index = fromIntegral (fromIntegral (index s) :: Int32) }--prop_symbol_2 :: Int64 -> Property-prop_symbol_2 n =-  withMaxSuccess 100000 $-  fromSymbol (toSymbol n) === n--return []-main = $forAllProperties (quickCheckWithResult stdArgs { maxSuccess = 1000000 })--t :: Term Func-t = build (app (fun (F 0)) [app (fun (F 1)) [var (V 0), var (V 1)], var (V 2)])
− src/Data/ChurchList.hs 
@@ -1,99 +0,0 @@--- Church-encoded lists. Used in Twee.CP to make sure that fusion happens.-{-# LANGUAGE Rank2Types, BangPatterns #-}-module Data.ChurchList where--import Prelude(Functor(..), Applicative(..), Monad(..), Bool(..), Maybe(..), (.), ($), id)-import qualified Prelude-import GHC.Magic(oneShot)-import GHC.Exts(build)-import Control.Monad(MonadPlus(..), liftM2)-import Control.Applicative(Alternative(..))--newtype ChurchList a =-  ChurchList (forall b. (a -> b -> b) -> b -> b)--{-# INLINE foldr #-}-foldr :: (a -> b -> b) -> b -> ChurchList a -> b-foldr op e (ChurchList f) = eta (f op (eta e))-  -- Using eta here seems to help with eta-expanding foldl'--{-# INLINE[0] eta #-}-eta :: a -> a-eta x = x-{-# RULES "eta" forall f. eta f = \x -> f x #-}--{-# INLINE nil #-}-nil :: ChurchList a-nil = ChurchList (\_ n -> n)--{-# INLINE unit #-}-unit :: a -> ChurchList a-unit x = ChurchList (\c n -> c x n)--{-# INLINE cons #-}-cons :: a -> ChurchList a -> ChurchList a-cons x xs = ChurchList (\c n -> c x (foldr c n xs))--{-# INLINE append #-}-append :: ChurchList a -> ChurchList a -> ChurchList a-append xs ys = ChurchList (\c n -> foldr c (foldr c n ys) xs)--{-# INLINE join #-}-join :: ChurchList (ChurchList a) -> ChurchList a-join xss = ChurchList (\c n -> foldr (\xs ys -> foldr c ys xs) n xss)--instance Functor ChurchList where-  {-# INLINE fmap #-}-  fmap f xs = ChurchList (\c n -> foldr (c . f) n xs)--instance Applicative ChurchList where-  {-# INLINE pure #-}-  pure = return-  {-# INLINE (<*>) #-}-  (<*>) = liftM2 ($)--instance Monad ChurchList where-  {-# INLINE return #-}-  return = unit-  {-# INLINE (>>=) #-}-  xs >>= f = join (fmap f xs)--instance Alternative ChurchList where-  {-# INLINE empty #-}-  empty = nil-  {-# INLINE (<|>) #-}-  (<|>) = append--instance MonadPlus ChurchList where-  {-# INLINE mzero #-}-  mzero = empty-  {-# INLINE mplus #-}-  mplus = (<|>)--{-# INLINE fromList #-}-fromList :: [a] -> ChurchList a-fromList xs = ChurchList (\c n -> Prelude.foldr c n xs)--{-# INLINE toList #-}-toList :: ChurchList a -> [a]-toList (ChurchList f) = build f--{-# INLINE foldl' #-}-foldl' :: (b -> a -> b) -> b -> ChurchList a -> b-foldl' op e xs =-  foldr (\x f -> oneShot (\ (!acc) -> f (op acc x))) id xs e--{-# INLINE filter #-}-filter :: (a -> Bool) -> ChurchList a -> ChurchList a-filter p xs =-  ChurchList $ \c n ->-    let            -      {-# INLINE op #-}-      op x xs = if p x then c x xs else xs-    in-      foldr op n xs--{-# INLINE fromMaybe #-}-fromMaybe :: Maybe a -> ChurchList a-fromMaybe Nothing = nil-fromMaybe (Just x) = unit x
− src/Data/DynamicArray.hs 
@@ -1,67 +0,0 @@--- | Zero-indexed dynamic arrays, optimised for lookup.--- Modification is slow. Uninitialised indices have a default value.-{-# LANGUAGE CPP #-}-module Data.DynamicArray where--#ifdef BOUNDS_CHECKS-import qualified Data.Primitive.SmallArray.Checked as P-#else-import qualified Data.Primitive.SmallArray as P-#endif-import Control.Monad.ST-import Data.List---- | A type which has a default value.-class Default a where-  -- | The default value.-  def :: a---- | An array.-data Array a =-  Array {-    -- | The size of the array.-    arraySize     :: {-# UNPACK #-} !Int,-    -- | The contents of the array.-    arrayContents :: {-# UNPACK #-} !(P.SmallArray a) }---- | Convert an array to a list of (index, value) pairs.-{-# INLINE toList #-}-toList :: Array a -> [(Int, a)]-toList arr =-  [ (i, x)-  | i <- [0..arraySize arr-1],-    let x = P.indexSmallArray (arrayContents arr) i ]--instance Show a => Show (Array a) where-  show arr =-    "{" ++-    intercalate ", "-      [ show i ++ "->" ++ show x-      | (i, x) <- toList arr ] ++-    "}"---- | Create an empty array.-newArray :: Default a => Array a-newArray = runST $ do-  marr <- P.newSmallArray 0 def-  arr  <- P.unsafeFreezeSmallArray marr-  return (Array 0 arr)---- | Index into an array. O(1) time.-{-# INLINE (!) #-}-(!) :: Default a => Array a -> Int -> a-arr ! n-  | 0 <= n && n < arraySize arr =-    P.indexSmallArray (arrayContents arr) n-  | otherwise = def---- | Update the array. O(n) time.-{-# INLINEABLE update #-}-update :: Default a => Int -> a -> Array a -> Array a-update n x arr = runST $ do-  let size = arraySize arr `max` (n+1)-  marr <- P.newSmallArray size def-  P.copySmallArray marr 0 (arrayContents arr) 0 (arraySize arr)-  P.writeSmallArray marr n $! x-  arr' <- P.unsafeFreezeSmallArray marr-  return (Array size arr')
− src/Data/Heap.hs 
@@ -1,154 +0,0 @@--- | Skew heaps.--{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}-module Data.Heap(-  Heap, empty, singleton, insert, removeMin, union, mapMaybe, size) where---- | A heap.---- Representation: the size of the heap, and the heap itself.-data Heap a = Heap {-# UNPACK #-} !Int !(Heap1 a) deriving Show--- N.B.: arguments are not strict so code has to take care--- to force stuff appropriately.-data Heap1 a = Nil | Node a (Heap1 a) (Heap1 a) deriving Show---- | Take the union of two heaps.-{-# INLINEABLE union #-}-union :: Ord a => Heap a -> Heap a -> Heap a-union (Heap n1 h1) (Heap n2 h2) = Heap (n1+n2) (union1 h1 h2)--{-# INLINEABLE union1 #-}-union1 :: forall a. Ord a => Heap1 a -> Heap1 a -> Heap1 a-union1 = u1-  where-    -- The generated code is better when we do everything-    -- through this u1 function instead of union1...-    -- This is because u1 has no Ord constraint in its type.-    u1 :: Heap1 a -> Heap1 a -> Heap1 a-    u1 Nil h = h-    u1 h Nil = h-    u1 h1@(Node x1 l1 r1) h2@(Node x2 l2 r2)-      | x1 <= x2 = (Node x1 $! u1 r1 h2) l1-      | otherwise = (Node x2 $! u1 r2 h1) l2---- | A singleton heap.-{-# INLINE singleton #-}-singleton :: a -> Heap a-singleton !x = Heap 1 (Node x Nil Nil)---- | The empty heap.-{-# INLINE empty #-}-empty :: Heap a-empty = Heap 0 Nil---- | Insert an element.-{-# INLINEABLE insert #-}-insert :: Ord a => a -> Heap a -> Heap a-insert x h = union (singleton x) h---- | Find and remove the minimum element.-{-# INLINEABLE removeMin #-}-removeMin :: Ord a => Heap a -> Maybe (a, Heap a)-removeMin (Heap _ Nil) = Nothing-removeMin (Heap n (Node x l r)) = Just (x, Heap (n-1) (union1 l r))---- | Map a function over a heap, removing all values which--- map to 'Nothing'. May be more efficient when the function--- being mapped is mostly monotonic.-{-# INLINEABLE mapMaybe #-}-mapMaybe :: Ord b => (a -> Maybe b) -> Heap a -> Heap b-mapMaybe f (Heap _ h) = Heap (sz 0 h') h'-  where-    -- Compute the size fairly efficiently.-    sz !n Nil = n-    sz !n (Node _ l r) = sz (sz (n+1) l) r--    h' = mm h--    mm Nil = Nil-    mm (Node x l r) =-      case f x of-        -- If the value maps to Nothing, get rid of it.-        Nothing -> union1 l' r'-        -- Otherwise, check if the heap invariant still holds-        -- and sift downwards to restore it.-        Just !y -> down y l' r'-      where-        !l' = mm l-        !r' = mm r--    down x l@(Node y ll lr) r@(Node z rl rr)-      -- Put the smallest of x, y and z at the root.-      | y < x && y <= z =-        (Node y $! down x ll lr) r-      | z < x && z <= y =-        Node z l $! down x rl rr-    down x Nil (Node y l r)-      -- Put the smallest of x and y at the root.-      | y < x =-        Node y Nil $! down x l r-    down x (Node y l r) Nil-      -- Put the smallest of x and y at the root.-      | y < x =-        (Node y $! down x l r) Nil-    down x l r = Node x l r---- | Return the number of elements in the heap.-{-# INLINE size #-}-size :: Heap a -> Int-size (Heap n _) = n---- Testing code:--- import Test.QuickCheck--- import qualified Data.List as List--- import qualified Data.Maybe as Maybe---- instance (Arbitrary a, Ord a) => Arbitrary (Heap a) where---   arbitrary = sized arb---     where---       arb 0 = return empty---       arb n =---         frequency---           [(1, singleton <$> arbitrary),---            (n-1, union <$> arb' <*> arb')]---         where---           arb' = arb (n `div` 2)---- toList :: Ord a => Heap a -> [a]--- toList = List.unfoldr removeMin---- invariant :: Ord a => Heap a -> Bool--- invariant h@(Heap n h1) =---   n == length (toList h) && ord h1---   where---     ord Nil = True---     ord (Node x l r) = ord1 x l && ord1 x r----     ord1 _ Nil = True---     ord1 x h@(Node y _ _) = x <= y && ord h---- prop_1 h = withMaxSuccess 10000 $ invariant h--- prop_2 x h = withMaxSuccess 10000 $ invariant (insert x h)--- prop_3 h =---   withMaxSuccess 1000 $---   case removeMin h of---     Nothing -> discard---     Just (_, h) -> invariant h--- prop_4 h = withMaxSuccess 10000 $ List.sort (toList h) == toList h--- prop_5 x h = withMaxSuccess 10000 $ toList (insert x h) == List.insert x (toList h)--- prop_6 x h =---   withMaxSuccess 1000 $---   case removeMin h of---     Nothing -> discard---     Just (x, h') -> toList h == List.insert x (toList h')--- prop_7 h1 h2 = withMaxSuccess 10000 $---   invariant (union h1 h2)--- prop_8 h1 h2 = withMaxSuccess 10000 $---   toList (union h1 h2) == List.sort (toList h1 ++ toList h2)--- prop_9 (Blind f) h = withMaxSuccess 10000 $---   invariant (mapMaybe f h)--- prop_10 (Blind f) h = withMaxSuccess 1000000 $---   toList (mapMaybe f h) == List.sort (Maybe.mapMaybe f (toList h))---- return []--- main = $quickCheckAll
− src/Data/Primitive/ByteArray/Checked.hs 
@@ -1,74 +0,0 @@--- | A bounds-checked version of 'Data.Primitive.ByteArray'.--- See that module for documentation.--{-# LANGUAGE ScopedTypeVariables #-}-module Data.Primitive.ByteArray.Checked(-  module Data.Primitive.ByteArray,-  module Data.Primitive.ByteArray.Checked) where--import Control.Monad.Primitive-import qualified Data.Primitive.ByteArray as P-import Data.Primitive(Prim)-import Data.Primitive.ByteArray(-  ByteArray(..), MutableByteArray(..),-  newByteArray, newPinnedByteArray, newAlignedPinnedByteArray,-  byteArrayContents, mutableByteArrayContents,-  sameMutableByteArray,-  unsafeFreezeByteArray, unsafeThawByteArray,-  sizeofByteArray, sizeofMutableByteArray)-import Data.Primitive.Checked-import Data.Word--instance Sized ByteArray where-  size = sizeofByteArray-instance Sized (MutableByteArray m) where-  size = sizeofMutableByteArray--{-# INLINE readByteArray #-}-readByteArray :: forall m a. (PrimMonad m, Prim a) => MutableByteArray (PrimState m) -> Int -> m a-readByteArray arr n =-  checkPrim (undefined :: a) arr n $-  P.readByteArray arr n--{-# INLINE writeByteArray #-}-writeByteArray :: (PrimMonad m, Prim a) => MutableByteArray (PrimState m) -> Int -> a -> m ()-writeByteArray arr n x =-  checkPrim x arr n $-  P.writeByteArray arr n x--{-# INLINE indexByteArray #-}-indexByteArray :: forall a. Prim a => ByteArray -> Int -> a-indexByteArray arr n =-  checkPrim (undefined :: a) arr n $-  P.indexByteArray arr n--{-# INLINE copyByteArray #-}-copyByteArray :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> ByteArray -> Int -> Int -> m ()-copyByteArray arr1 n1 arr2 n2 len =-  range arr1 n1 len $-  range arr2 n2 len $-  P.copyByteArray arr1 n1 arr2 n2 len--{-# INLINE moveByteArray #-}-moveByteArray :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()-moveByteArray arr1 n1 arr2 n2 len =-  range arr1 n1 len $-  range arr2 n2 len $-  P.moveByteArray arr1 n1 arr2 n2 len--{-# INLINE copyMutableByteArray #-}-copyMutableByteArray :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()-copyMutableByteArray arr1 n1 arr2 n2 len =-  range arr1 n1 len $-  range arr2 n2 len $-  P.copyMutableByteArray arr1 n1 arr2 n2 len--{-# INLINE setByteArray #-}-setByteArray :: (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()-setByteArray arr n len x =-  rangePrim x arr n len $-  P.setByteArray arr n len x--{-# INLINE fillByteArray #-}-fillByteArray :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> Int -> Word8 -> m ()-fillByteArray = setByteArray
− src/Data/Primitive/Checked.hs 
@@ -1,46 +0,0 @@--- | A helper module for array bounds checking.--module Data.Primitive.Checked where--import Data.Primitive(Prim, sizeOf)---- | A type class of things which have a size (e.g., arrays).-class Sized a where-  -- | Read the size of the thing.-  size :: a -> Int---- | Check that a single access is in bounds.-{-# INLINE check #-}-check :: Sized a => a -> Int -> b -> b-check arr n x-  | n >= 0 && n < size arr = x-  | otherwise = error "out-of-bounds array access"---- | Check that a range of accesses is in bounds.--- The range is inclusive.-{-# INLINE range #-}-range :: Sized a => a -> Int -> Int -> b -> b-range arr n len x-  | len < 0 = error "array slice has negative length"-  | len == 0 = x-  | otherwise =-    check arr n $-    check arr (n+len-1) $ x---- | Check that a single access is in bounds.--- The index accessed is computed by multiplying by the size--- of the first argument.-{-# INLINE checkPrim #-}-checkPrim :: (Sized a, Prim b) => b -> a -> Int -> c -> c-checkPrim x arr n res =-  range arr (n*sizeOf x) (sizeOf x) res-  --- | Check that a range of accesses is in bounds.--- The range is inclusive.--- The index accessed is computed by multiplying by the size--- of the first argument.-{-# INLINE rangePrim #-}-rangePrim :: (Sized a, Prim b) => b -> a -> Int -> Int -> c -> c-rangePrim x arr n len res =-  range arr (n*sizeOf x) (len*sizeOf x) res-
− src/Data/Primitive/SmallArray/Checked.hs 
@@ -1,80 +0,0 @@--- | A bounds-checked version of 'Data.Primitive.SmallArray'.--- See that module for documentation.--module Data.Primitive.SmallArray.Checked(-  module Data.Primitive.SmallArray,-  module Data.Primitive.SmallArray.Checked) where--import Control.Monad.Primitive-import qualified Data.Primitive.SmallArray as P-import Data.Primitive.SmallArray(-  SmallArray(..), SmallMutableArray(..), newSmallArray, unsafeFreezeSmallArray,-  unsafeThawSmallArray, sizeofSmallArray, sizeofSmallMutableArray)-import Data.Primitive.Checked--instance Sized (SmallArray a) where-  size = sizeofSmallArray-instance Sized (SmallMutableArray m a) where-  size = sizeofSmallMutableArray--{-# INLINE readSmallArray #-}-readSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> m a-readSmallArray arr n =-  check arr n $-  P.readSmallArray arr n--{-# INLINE writeSmallArray #-}-writeSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> a -> m ()-writeSmallArray arr n x =-  check arr n $-  P.writeSmallArray arr n x--{-# INLINE indexSmallArrayM #-}-indexSmallArrayM :: Monad m => SmallArray a -> Int -> m a-indexSmallArrayM arr n =-  check arr n $-  P.indexSmallArrayM arr n--{-# INLINE indexSmallArray #-}-indexSmallArray :: SmallArray a -> Int -> a-indexSmallArray arr n =-  check arr n $-  P.indexSmallArray arr n--{-# INLINE cloneSmallArray #-}-cloneSmallArray :: SmallArray a -> Int -> Int -> SmallArray a-cloneSmallArray arr n len =-  range arr n len $-  P.cloneSmallArray arr n len--{-# INLINE cloneSmallMutableArray #-}-cloneSmallMutableArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)-cloneSmallMutableArray arr n len =-  range arr n len $-  P.cloneSmallMutableArray arr n len--{-# INLINE freezeSmallArray #-}-freezeSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> Int -> m (SmallArray a)-freezeSmallArray arr n len =-  range arr n len $-  P.freezeSmallArray arr n len--{-# INLINE thawSmallArray #-}-thawSmallArray :: PrimMonad m => SmallArray a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)-thawSmallArray arr n len =-  range arr n len $-  P.thawSmallArray arr n len--{-# INLINE copySmallArray #-}-copySmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> SmallArray a -> Int -> Int -> m ()-copySmallArray arr1 n1 arr2 n2 len =-  range arr1 n1 len $-  range arr2 n2 len $-  P.copySmallArray arr1 n1 arr2 n2 len--{-# INLINE copySmallMutableArray #-}-copySmallMutableArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()-copySmallMutableArray arr1 n1 arr2 n2 len =-  range arr1 n1 len $-  range arr2 n2 len $-  P.copySmallMutableArray arr1 n1 arr2 n2 len
− src/Twee.hs 
@@ -1,610 +0,0 @@--- | The main prover loop.-{-# LANGUAGE RecordWildCards, MultiParamTypeClasses, GADTs, BangPatterns, OverloadedStrings, ScopedTypeVariables, GeneralizedNewtypeDeriving, PatternGuards, TypeFamilies #-}-module Twee where--import Twee.Base-import Twee.Rule-import Twee.Equation-import qualified Twee.Proof as Proof-import Twee.Proof(Proof, Axiom(..), Lemma(..), ProvedGoal(..), provedGoal, certify, derivation, symm)-import Twee.CP hiding (Config)-import qualified Twee.CP as CP-import Twee.Join hiding (Config, defaultConfig)-import qualified Twee.Join as Join-import qualified Twee.Rule.Index as RuleIndex-import Twee.Rule.Index(RuleIndex(..))-import qualified Twee.Index as Index-import Twee.Index(Index)-import Twee.Constraints-import Twee.Utils-import Twee.Task-import qualified Twee.PassiveQueue as Queue-import Twee.PassiveQueue(Queue, Passive(..))-import qualified Data.IntMap.Strict as IntMap-import Data.IntMap(IntMap)-import Data.Maybe-import Data.List-import Data.Function-import qualified Data.Set as Set-import Data.Set(Set)-import Data.Int-import Data.Ord-import Control.Monad-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import qualified Control.Monad.Trans.State.Strict as StateM--------------------------------------------------------------------------- * Configuration and prover state.--------------------------------------------------------------------------- | The prover configuration.-data Config =-  Config {-    cfg_max_term_size          :: Int,-    cfg_max_critical_pairs     :: Int64,-    cfg_max_cp_depth           :: Int,-    cfg_simplify               :: Bool,-    cfg_renormalise_percent    :: Int,-    cfg_critical_pairs         :: CP.Config,-    cfg_join                   :: Join.Config,-    cfg_proof_presentation     :: Proof.Config }---- | The prover state.-data State f =-  State {-    st_rules          :: !(RuleIndex f (ActiveRule f)),-    st_active_ids     :: !(IntMap (Active f)),-    st_rule_ids       :: !(IntMap (ActiveRule f)),-    st_joinable       :: !(Index f (Equation f)),-    st_goals          :: ![Goal f],-    st_queue          :: !(Queue Params),-    st_next_active    :: {-# UNPACK #-} !Id,-    st_next_rule      :: {-# UNPACK #-} !RuleId,-    st_considered     :: {-# UNPACK #-} !Int64,-    st_messages_rev   :: ![Message f] }---- | The default prover configuration.-defaultConfig :: Config-defaultConfig =-  Config {-    cfg_max_term_size = maxBound,-    cfg_max_critical_pairs = maxBound,-    cfg_max_cp_depth = maxBound,-    cfg_simplify = True,-    cfg_renormalise_percent = 5,-    cfg_critical_pairs = CP.defaultConfig,-    cfg_join = Join.defaultConfig,-    cfg_proof_presentation = Proof.defaultConfig }---- | Does this configuration run the prover in a complete mode?-configIsComplete :: Config -> Bool-configIsComplete Config{..} =-  cfg_max_term_size == maxBound &&-  cfg_max_critical_pairs == maxBound &&-  cfg_max_cp_depth == maxBound---- | The initial state.-initialState :: State f-initialState =-  State {-    st_rules = RuleIndex.empty,-    st_active_ids = IntMap.empty,-    st_rule_ids = IntMap.empty,-    st_joinable = Index.empty,-    st_goals = [],-    st_queue = Queue.empty,-    st_next_active = 1,-    st_next_rule = 0,-    st_considered = 0,-    st_messages_rev = [] }--------------------------------------------------------------------------- * Messages.--------------------------------------------------------------------------- | A message which is produced by the prover when something interesting happens.-data Message f =-    -- | A new rule.-    NewActive !(Active f)-    -- | A new joinable equation.-  | NewEquation !(Equation f)-    -- | A rule was deleted.-  | DeleteActive !(Active f)-    -- | The CP queue was simplified.-  | SimplifyQueue-    -- | The rules were reduced wrt each other.-  | Interreduce--instance Function f => Pretty (Message f) where-  pPrint (NewActive rule) = pPrint rule-  pPrint (NewEquation eqn) =-    text "  (hard)" <+> pPrint eqn-  pPrint (DeleteActive rule) =-    text "  (delete rule " <> pPrint (active_id rule) <> text ")"-  pPrint SimplifyQueue =-    text "  (simplifying queued critical pairs...)"-  pPrint Interreduce =-    text "  (simplifying rules with respect to one another...)"---- | Emit a message.-message :: PrettyTerm f => Message f -> State f -> State f-message !msg state@State{..} =-  state { st_messages_rev = msg:st_messages_rev }---- | Forget about all emitted messages.-clearMessages :: State f -> State f-clearMessages state@State{..} =-  state { st_messages_rev = [] }---- | Get all emitted messages.-messages :: State f -> [Message f]-messages state = reverse (st_messages_rev state)--------------------------------------------------------------------------- * The CP queue.-------------------------------------------------------------------------data Params-instance Queue.Params Params where-  type Score Params = Int-  type Id Params = RuleId-  type PackedId Params = Int32-  type PackedScore Params = Int32-  packScore _ = fromIntegral-  unpackScore _ = fromIntegral-  packId _ = fromIntegral-  unpackId _ = fromIntegral---- | Compute all critical pairs from a rule.-{-# INLINEABLE makePassives #-}-makePassives :: Function f => Config -> State f -> ActiveRule f -> [Passive Params]-makePassives Config{..} State{..} rule =-  {-# SCC makePassive #-}-  [ Passive (fromIntegral (score cfg_critical_pairs o)) (rule_rid rule1) (rule_rid rule2) (fromIntegral (overlap_pos o))-  | (rule1, rule2, o) <- overlaps (Depth cfg_max_cp_depth) (index_oriented st_rules) rules rule ]-  where-    rules = IntMap.elems st_rule_ids---- | Turn a Passive back into an overlap.--- Doesn't try to simplify it.-{-# INLINEABLE findPassive #-}-findPassive :: forall f. Function f => Config -> State f -> Passive Params -> Maybe (ActiveRule f, ActiveRule f, Overlap f)-findPassive Config{..} State{..} Passive{..} = {-# SCC findPassive #-} do-  rule1 <- IntMap.lookup (fromIntegral passive_rule1) st_rule_ids-  rule2 <- IntMap.lookup (fromIntegral passive_rule2) st_rule_ids-  let !depth = 1 + max (the rule1) (the rule2)-  overlap <--    overlapAt (fromIntegral passive_pos) depth-      (renameAvoiding (the rule2 :: Rule f) (the rule1)) (the rule2)-  return (rule1, rule2, overlap)---- | Renormalise a queued Passive.-{-# INLINEABLE simplifyPassive #-}-simplifyPassive :: Function f => Config -> State f -> Passive Params -> Maybe (Passive Params)-simplifyPassive config@Config{..} state@State{..} passive = {-# SCC simplifyPassive #-} do-  (_, _, overlap) <- findPassive config state passive-  overlap <- simplifyOverlap (index_oriented st_rules) overlap-  return passive {-    passive_score = fromIntegral $-      fromIntegral (passive_score passive) `intMin`-      score cfg_critical_pairs overlap }---- | Renormalise the entire queue.-{-# INLINEABLE simplifyQueue #-}-simplifyQueue :: Function f => Config -> State f -> State f-simplifyQueue config state =-  {-# SCC simplifyQueue #-}-  state { st_queue = simp (st_queue state) }-  where-    simp =-      Queue.mapMaybe (simplifyPassive config state)---- | Enqueue a set of critical pairs.-{-# INLINEABLE enqueue #-}-enqueue :: Function f => State f -> RuleId -> [Passive Params] -> State f-enqueue state rule passives =-  {-# SCC enqueue #-}-  state { st_queue = Queue.insert rule passives (st_queue state) }---- | Dequeue a critical pair.------ Also takes care of:------   * removing any orphans from the head of the queue---   * ignoring CPs that are too big-{-# INLINEABLE dequeue #-}-dequeue :: Function f => Config -> State f -> (Maybe (CriticalPair f, ActiveRule f, ActiveRule f), State f)-dequeue config@Config{..} state@State{..} =-  {-# SCC dequeue #-}-  case deq 0 st_queue of-    -- Explicitly make the queue empty, in case it e.g. contained a-    -- lot of orphans-    Nothing -> (Nothing, state { st_queue = Queue.empty })-    Just (overlap, n, queue) ->-      (Just overlap,-       state { st_queue = queue, st_considered = st_considered + n })-  where-    deq !n queue = do-      (passive, queue) <- Queue.removeMin queue-      case findPassive config state passive of-        Just (rule1, rule2, overlap)-          | passive_score passive >= 0,-            Just Overlap{overlap_eqn = t :=: u} <--              simplifyOverlap (index_oriented st_rules) overlap,-            size t <= cfg_max_term_size,-            size u <= cfg_max_term_size,-            Just cp <- makeCriticalPair rule1 rule2 overlap ->-              return ((cp, rule1, rule2), n+1, queue)-        _ -> deq (n+1) queue--------------------------------------------------------------------------- * Active rewrite rules.-------------------------------------------------------------------------data Active f =-  Active {-    active_id    :: {-# UNPACK #-} !Id,-    active_depth :: {-# UNPACK #-} !Depth,-    active_rule  :: {-# UNPACK #-} !(Rule f),-    active_top   :: !(Maybe (Term f)),-    active_proof :: {-# UNPACK #-} !(Proof f),-    -- A model in which the rule is false (used when reorienting)-    active_model :: !(Model f),-    active_rules :: ![ActiveRule f] }--active_cp :: Active f -> CriticalPair f-active_cp Active{..} =-  CriticalPair {-    cp_eqn = unorient active_rule,-    cp_depth = active_depth,-    cp_top = active_top,-    cp_proof = derivation active_proof }---- An active oriented in a particular direction.-data ActiveRule f =-  ActiveRule {-    rule_active    :: {-# UNPACK #-} !Id,-    rule_rid       :: {-# UNPACK #-} !RuleId,-    rule_depth     :: {-# UNPACK #-} !Depth,-    rule_rule      :: {-# UNPACK #-} !(Rule f),-    rule_proof     :: {-# UNPACK #-} !(Proof f),-    rule_positions :: !(Positions f) }--instance PrettyTerm f => Symbolic (ActiveRule f) where-  type ConstantOf (ActiveRule f) = f-  termsDL ActiveRule{..} =-    termsDL rule_rule `mplus`-    termsDL (derivation rule_proof)-  subst_ sub r@ActiveRule{..} =-    r {-      rule_rule = rule',-      rule_proof = certify (subst_ sub (derivation rule_proof)),-      rule_positions = positions (lhs rule') }-    where-      rule' = subst_ sub rule_rule--instance Eq (Active f) where-  (==) = (==) `on` active_id--instance Eq (ActiveRule f) where-  (==) = (==) `on` rule_rid--instance Function f => Pretty (Active f) where-  pPrint Active{..} =-    pPrint active_id <> text "." <+> pPrint (canonicalise active_rule)--instance Has (ActiveRule f) Id where the = rule_active-instance Has (ActiveRule f) RuleId where the = rule_rid-instance Has (ActiveRule f) Depth where the = rule_depth-instance f ~ g => Has (ActiveRule f) (Rule g) where the = rule_rule-instance f ~ g => Has (ActiveRule f) (Proof g) where the = rule_proof-instance f ~ g => Has (ActiveRule f) (Lemma g) where the x = Lemma (the x) (the x)-instance f ~ g => Has (ActiveRule f) (Positions g) where the = rule_positions--newtype RuleId = RuleId Id deriving (Eq, Ord, Show, Num, Real, Integral, Enum)---- Add a new active.-{-# INLINEABLE addActive #-}-addActive :: Function f => Config -> State f -> (Id -> RuleId -> RuleId -> Active f) -> State f-addActive config state@State{..} active0 =-  {-# SCC addActive #-}-  let-    active@Active{..} = active0 st_next_active st_next_rule (succ st_next_rule)-    state' =-      message (NewActive active) $-      addActiveOnly state{st_next_active = st_next_active+1, st_next_rule = st_next_rule+2} active-  in if subsumed st_joinable st_rules (unorient active_rule) then-    state-  else-    normaliseGoals $-    foldl' (uncurry . enqueue) state'-      [ (the rule, makePassives config state' rule)-      | rule <- active_rules ]---- Add an active without generating critical pairs. Used in interreduction.-{-# INLINEABLE addActiveOnly #-}-addActiveOnly :: Function f => State f -> Active f -> State f-addActiveOnly state@State{..} active@Active{..} =-  state {-    st_rules = foldl' insertRule st_rules active_rules,-    st_active_ids = IntMap.insert (fromIntegral active_id) active st_active_ids,-    st_rule_ids = foldl' insertRuleId st_rule_ids active_rules }-  where-    insertRule rules rule@ActiveRule{..} =-      RuleIndex.insert (lhs rule_rule) rule rules-    insertRuleId rules rule@ActiveRule{..} =-      IntMap.insert (fromIntegral rule_rid) rule rules---- Delete an active. Used in interreduction, not suitable for general use.-{-# INLINE deleteActive #-}-deleteActive :: Function f => State f -> Active f -> State f-deleteActive state@State{..} Active{..} =-  state {-    st_rules = foldl' deleteRule st_rules active_rules,-    st_active_ids = IntMap.delete (fromIntegral active_id) st_active_ids,-    st_rule_ids = foldl' deleteRuleId st_rule_ids active_rules }-  where-    deleteRule rules rule =-      RuleIndex.delete (lhs (rule_rule rule)) rule rules-    deleteRuleId rules ActiveRule{..} =-      IntMap.delete (fromIntegral rule_rid) rules---- Try to join a critical pair.-{-# INLINEABLE consider #-}-consider :: Function f => Config -> State f -> CriticalPair f -> State f-consider config state cp =-  considerUsing (st_rules state) config state cp---- Try to join a critical pair, but using a different set of critical--- pairs for normalisation.-{-# INLINEABLE considerUsing #-}-considerUsing ::-  Function f =>-  RuleIndex f (ActiveRule f) -> Config -> State f -> CriticalPair f -> State f-considerUsing rules config@Config{..} state@State{..} cp0 =-  {-# SCC consider #-}-  -- Important to canonicalise the rule so that we don't get-  -- bigger and bigger variable indices over time-  let cp = canonicalise cp0 in-  case joinCriticalPair cfg_join st_joinable rules Nothing cp of-    Right (mcp, cps) ->-      let-        state' = foldl' (considerUsing rules config) state cps-      in case mcp of-        Just cp -> addJoinable state' (cp_eqn cp)-        Nothing -> state'--    Left (cp, model) ->-      foldl' (addCP config model) state (split cp)--{-# INLINEABLE addCP #-}-addCP :: Function f => Config -> Model f -> State f -> CriticalPair f -> State f-addCP config model state@State{..} CriticalPair{..} =-  addActive config state $ \n k1 k2 ->-  let-    pf = certify cp_proof-    rule = orient cp_eqn--    makeRule k r p =-      ActiveRule {-        rule_active = n,-        rule_rid = k,-        rule_depth = cp_depth,-        rule_rule = r rule,-        rule_proof = p pf,-        rule_positions = positions (lhs (r rule)) }-  in-  Active {-    active_id = n,-    active_depth = cp_depth,-    active_rule = rule,-    active_model = model,-    active_top = cp_top,-    active_proof = pf,-    active_rules =-      usortBy (comparing (canonicalise . rule_rule)) $-        makeRule k1 id id:-        [ makeRule k2 backwards (certify . symm . derivation)-        | not (oriented (orientation rule)) ] }---- Add a new equation.-{-# INLINEABLE addAxiom #-}-addAxiom :: Function f => Config -> State f -> Axiom f -> State f-addAxiom config state axiom =-  consider config state $-    CriticalPair {-      cp_eqn = axiom_eqn axiom,-      cp_depth = 0,-      cp_top = Nothing,-      cp_proof = Proof.axiom axiom }---- Record an equation as being joinable.-{-# INLINEABLE addJoinable #-}-addJoinable :: Function f => State f -> Equation f -> State f-addJoinable state eqn@(t :=: u) =-  message (NewEquation eqn) $-  state {-    st_joinable =-      Index.insert t (t :=: u) $-      Index.insert u (u :=: t) (st_joinable state) }---- For goal terms we store the set of all their normal forms.--- Name and number are for information only.-data Goal f =-  Goal {-    goal_name   :: String,-    goal_number :: Int,-    goal_eqn    :: Equation f,-    goal_lhs    :: Set (Resulting f),-    goal_rhs    :: Set (Resulting f) }---- Add a new goal.-{-# INLINEABLE addGoal #-}-addGoal :: Function f => Config -> State f -> Goal f -> State f-addGoal _config state@State{..} goal =-  normaliseGoals state { st_goals = goal:st_goals }---- Normalise all goals.-{-# INLINEABLE normaliseGoals #-}-normaliseGoals :: Function f => State f -> State f-normaliseGoals state@State{..} =-  {-# SCC normaliseGoals #-}-  state {-    st_goals =-      map (goalMap (successors (rewrite reduces (index_all st_rules)) . Set.toList)) st_goals }-  where-    goalMap f goal@Goal{..} =-      goal { goal_lhs = f goal_lhs, goal_rhs = f goal_rhs }---- Create a goal.-{-# INLINE goal #-}-goal :: Int -> String -> Equation f -> Goal f-goal n name (t :=: u) =-  Goal {-    goal_name = name,-    goal_number = n,-    goal_eqn = t :=: u,-    goal_lhs = Set.singleton (reduce (Refl t)),-    goal_rhs = Set.singleton (reduce (Refl u)) }--------------------------------------------------------------------------- Interreduction.--------------------------------------------------------------------------- Simplify all rules.-{-# INLINEABLE interreduce #-}-interreduce :: Function f => Config -> State f -> State f-interreduce config@Config{..} state =-  {-# SCC interreduce #-}-  let-    state' =-      foldl' (interreduce1 config)-        -- Clear out st_joinable, since we don't know which-        -- equations have made use of each active.-        state { st_joinable = Index.empty }-        (IntMap.elems (st_active_ids state))-    in state' { st_joinable = st_joinable state }--{-# INLINEABLE interreduce1 #-}-interreduce1 :: Function f => Config -> State f -> Active f -> State f-interreduce1 config@Config{..} state active =-  -- Exclude the active from the rewrite rules when testing-  -- joinability, otherwise it will be trivially joinable.-  case-    joinCriticalPair cfg_join-      (st_joinable state)-      (st_rules (deleteActive state active))-      (Just (active_model active)) (active_cp active)-  of-    Right (_, cps) ->-      flip (foldl' (consider config)) cps $-      message (DeleteActive active) $-      deleteActive state active-    Left (cp, model)-      | not (cp_eqn cp `isInstanceOf` cp_eqn (active_cp active)) ->-        flip (foldl' (addCP config model)) (split cp) $-        message (DeleteActive active) $-        deleteActive state active-      | model /= active_model active ->-        flip addActiveOnly active { active_model = model } $-        deleteActive state active-      | otherwise ->-        state-  where-    (t :=: u) `isInstanceOf` (t' :=: u') = isJust $ do-      sub <- match t' t-      matchIn sub u' u---------------------------------------------------------------------------- The main loop.-------------------------------------------------------------------------data Output m f =-  Output {-    output_message :: Message f -> m () }--{-# INLINE complete #-}-complete :: (Function f, MonadIO m) => Output m f -> Config -> State f -> m (State f)-complete Output{..} config@Config{..} state =-  flip StateM.execStateT state $ do-    tasks <- sequence-      [newTask 1 (fromIntegral cfg_renormalise_percent / 100) $ do-         lift $ output_message SimplifyQueue-         state <- StateM.get-         StateM.put $! simplifyQueue config state,-       newTask 0.25 0.05 $ do-         when cfg_simplify $ do-           lift $ output_message Interreduce-           state <- StateM.get-           StateM.put $! interreduce config state]--    let-      loop = do-        progress <- StateM.state (complete1 config)-        state <- StateM.get-        lift $ mapM_ output_message (messages state)-        StateM.put (clearMessages state)-        mapM_ checkTask tasks-        when progress loop--    loop--{-# INLINEABLE complete1 #-}-complete1 :: Function f => Config -> State f -> (Bool, State f)-complete1 config@Config{..} state-  | st_considered state >= cfg_max_critical_pairs =-    (False, state)-  | solved state = (False, state)-  | otherwise =-    case dequeue config state of-      (Nothing, state) -> (False, state)-      (Just (overlap, _, _), state) ->-        (True, consider config state overlap)--{-# INLINEABLE solved #-}-solved :: Function f => State f -> Bool-solved = not . null . solutions---- Return whatever goals we have proved and their proofs.-{-# INLINEABLE solutions #-}-solutions :: Function f => State f -> [ProvedGoal f]-solutions State{..} = {-# SCC solutions #-} do-  Goal{goal_lhs = ts, goal_rhs = us, ..} <- st_goals-  guard (not (null (Set.intersection ts us)))-  let t:_ = filter (`Set.member` us) (Set.toList ts)-      u:_ = filter (== t) (Set.toList us)-      -- Strict so that we check the proof before returning a solution-      !p =-        Proof.certify $-          reductionProof (reduction t) `Proof.trans`-          Proof.symm (reductionProof (reduction u))-  return (provedGoal goal_number goal_name p)---- Return all current rewrite rules.-{-# INLINEABLE rules #-}-rules :: Function f => State f -> [Rule f]-rules = map active_rule . IntMap.elems . st_active_ids--------------------------------------------------------------------------- For code which uses twee as a library.-------------------------------------------------------------------------{-# INLINEABLE completePure #-}-completePure :: Function f => Config -> State f -> State f-completePure cfg state-  | progress = completePure cfg (clearMessages state')-  | otherwise = state'-  where-    (progress, state') = complete1 cfg state--{-# INLINEABLE normaliseTerm #-}-normaliseTerm :: Function f => State f -> Term f -> Resulting f-normaliseTerm State{..} t =-  normaliseWith (const True) (rewrite reduces (index_all st_rules)) t--{-# INLINEABLE simplifyTerm #-}-simplifyTerm :: Function f => State f -> Term f -> Term f-simplifyTerm State{..} t =-  simplify (index_oriented st_rules) t
− src/Twee/Base.hs 
@@ -1,285 +0,0 @@--- | Useful operations on terms and similar. Also re-exports some generally--- useful modules such as 'Twee.Term' and 'Twee.Pretty'.--{-# LANGUAGE TypeFamilies, FlexibleInstances, UndecidableInstances, DeriveFunctor, DefaultSignatures, FlexibleContexts, TypeOperators, MultiParamTypeClasses, GeneralizedNewtypeDeriving, ConstraintKinds, RecordWildCards #-}-module Twee.Base(-  -- * Re-exported functionality-  module Twee.Term, module Twee.Pretty,-  -- * The 'Symbolic' typeclass-  Symbolic(..), subst, terms,-  TermOf, TermListOf, SubstOf, TriangleSubstOf, BuilderOf, FunOf,-  vars, isGround, funs, occ, occVar, canonicalise, renameAvoiding,-  -- * General-purpose functionality-  Id(..), Has(..),-  -- * Typeclasses-  Minimal(..), minimalTerm, isMinimal, erase,-  Skolem(..), Arity(..), Sized(..), Ordered(..), lessThan, orientTerms, EqualsBonus(..), Strictness(..), Function, Extended(..)) where--import Prelude hiding (lookup)-import Control.Monad-import qualified Data.DList as DList-import Twee.Term hiding (subst, canonicalise)-import qualified Twee.Term as Term-import Twee.Pretty-import Twee.Constraints hiding (funs)-import Data.DList(DList)-import Data.Typeable-import Data.Int-import Data.Maybe-import qualified Data.IntMap.Strict as IntMap---- | Represents a unique identifier (e.g., for a rule).-newtype Id = Id { unId :: Int32 }-  deriving (Eq, Ord, Show, Enum, Bounded, Num, Real, Integral)--instance Pretty Id where-  pPrint = text . show . unId---- | Generalisation of term functionality to things that contain terms (e.g.,--- rewrite rules and equations).-class Symbolic a where-  type ConstantOf a--  -- | Compute a 'DList' of all terms which appear in the argument-  -- (used for e.g. computing free variables).-  -- See also 'terms'.-  termsDL :: a -> DList (TermListOf a)--  -- | Apply a substitution.-  -- When using the 'Symbolic' type class, you can use 'subst' instead.-  subst_ :: (Var -> BuilderOf a) -> a -> a---- | Apply a substitution.-subst :: (Symbolic a, Substitution s, SubstFun s ~ ConstantOf a) => s -> a -> a-subst sub x = subst_ (evalSubst sub) x---- | Find all terms occuring in the argument.-terms :: Symbolic a => a -> [TermListOf a]-terms = DList.toList . termsDL---- | A term compatible with a given 'Symbolic'.-type TermOf a = Term (ConstantOf a)--- | A termlist compatible with a given 'Symbolic'.-type TermListOf a = TermList (ConstantOf a)--- | A substitution compatible with a given 'Symbolic'.-type SubstOf a = Subst (ConstantOf a)--- | A triangle substitution compatible with a given 'Symbolic'.-type TriangleSubstOf a = TriangleSubst (ConstantOf a)--- | A builder compatible with a given 'Symbolic'.-type BuilderOf a = Builder (ConstantOf a)--- | The underlying type of function symbols of a given 'Symbolic'.-type FunOf a = Fun (ConstantOf a)--instance Symbolic (Term f) where-  type ConstantOf (Term f) = f-  termsDL = return . singleton-  subst_ sub = build . Term.subst sub--instance Symbolic (TermList f) where-  type ConstantOf (TermList f) = f-  termsDL = return-  subst_ sub = buildList . Term.substList sub--instance Symbolic (Subst f) where-  type ConstantOf (Subst f) = f-  termsDL (Subst sub) = termsDL (IntMap.elems sub)-  subst_ sub (Subst s) = Subst (fmap (subst_ sub) s)--instance (ConstantOf a ~ ConstantOf b, Symbolic a, Symbolic b) => Symbolic (a, b) where-  type ConstantOf (a, b) = ConstantOf a-  termsDL (x, y) = termsDL x `mplus` termsDL y-  subst_ sub (x, y) = (subst_ sub x, subst_ sub y)--instance (ConstantOf a ~ ConstantOf b,-          ConstantOf a ~ ConstantOf c,-          Symbolic a, Symbolic b, Symbolic c) => Symbolic (a, b, c) where-  type ConstantOf (a, b, c) = ConstantOf a-  termsDL (x, y, z) = termsDL x `mplus` termsDL y `mplus` termsDL z-  subst_ sub (x, y, z) = (subst_ sub x, subst_ sub y, subst_ sub z)--instance Symbolic a => Symbolic [a] where-  type ConstantOf [a] = ConstantOf a-  termsDL xs = msum (map termsDL xs)-  subst_ sub xs = map (subst_ sub) xs--instance Symbolic a => Symbolic (Maybe a) where-  type ConstantOf (Maybe a) = ConstantOf a-  termsDL Nothing = mzero-  termsDL (Just x) = termsDL x-  subst_ sub x = fmap (subst_ sub) x---- | An instance @'Has' a b@ indicates that a value of type @a@ contains a value--- of type @b@ which is somehow part of the meaning of the @a@.------ A number of functions use 'Has' constraints to work in a more general setting.--- For example, the functions in 'Twee.CP' operate on rewrite rules, but actually--- accept any @a@ satisfying @'Has' a ('Twee.Rule.Rule' f)@.------ Use taste when definining 'Has' instances; don't do it willy-nilly.-class Has a b where-  -- | Get at the thing.-  the :: a -> b--instance Has a a where-  the = id---- | Find the variables occurring in the argument.-{-# INLINE vars #-}-vars :: Symbolic a => a -> [Var]-vars x = [ v | t <- DList.toList (termsDL x), Var v <- subtermsList t ]---- | Test if the argument is ground.-{-# INLINE isGround #-}-isGround :: Symbolic a => a -> Bool-isGround = null . vars---- | Find the function symbols occurring in the argument.-{-# INLINE funs #-}-funs :: Symbolic a => a -> [FunOf a]-funs x = [ f | t <- DList.toList (termsDL x), App f _ <- subtermsList t ]---- | Count how many times a function symbol occurs in the argument.-{-# INLINE occ #-}-occ :: Symbolic a => FunOf a -> a -> Int-occ x t = length (filter (== x) (funs t))---- | Count how many times a variable occurs in the argument.-{-# INLINE occVar #-}-occVar :: Symbolic a => Var -> a -> Int-occVar x t = length (filter (== x) (vars t))---- | Rename the argument so that variables are introduced in a canonical order--- (starting with V0, then V1 and so on).-{-# INLINEABLE canonicalise #-}-canonicalise :: Symbolic a => a -> a-canonicalise t = subst sub t-  where-    sub = Term.canonicalise (DList.toList (termsDL t))---- | Rename the second argument so that it does not mention any variable which--- occurs in the first.-{-# INLINEABLE renameAvoiding #-}-renameAvoiding :: (Symbolic a, Symbolic b) => a -> b -> b-renameAvoiding x y-  | x2 < y1 || y2 < x1 =-    -- No overlap. Important in the case when x is ground,-    -- in which case x2 == minBound and the calculation below doesn't work.-    y-  | otherwise =-    -- Map y1 to x2+1-    subst (\(V x) -> var (V (x-y1+x2+1))) y-  where-    (V x1, V x2) = boundLists (terms x)-    (V y1, V y2) = boundLists (terms y)---- | Check if a term is the minimal constant.-isMinimal :: Minimal f => Term f -> Bool-isMinimal (App f Empty) | f == minimal = True-isMinimal _ = False---- | Build the minimal constant as a term.-minimalTerm :: Minimal f => Term f-minimalTerm = build (con minimal)---- | Erase a given set of variables from the argument, replacing them with the--- minimal constant.-erase :: (Symbolic a, ConstantOf a ~ f, Minimal f) => [Var] -> a -> a-erase [] t = t-erase xs t = subst sub t-  where-    sub = fromMaybe undefined $ listToSubst [(x, minimalTerm) | x <- xs]---- | Construction of Skolem constants.-class Skolem f where-  -- | Turn a variable into a Skolem constant.-  skolem  :: Var -> Fun f---- | For types which have a notion of arity.-class Arity f where-  -- | Measure the arity.-  arity :: f -> Int--instance Arity f => Arity (Fun f) where-  arity = arity . fun_value---- | For types which have a notion of size.-class Sized a where-  -- | Compute the size.-  size  :: a -> Int--instance Sized f => Sized (Fun f) where-  size = size . fun_value--instance Sized f => Sized (TermList f) where-  size = aux 0-    where-      aux n Empty = n-      aux n (ConsSym (App f _) t) = aux (n+size f) t-      aux n (Cons (Var _) t) = aux (n+1) t--instance Sized f => Sized (Term f) where-  size = size . singleton---- | The collection of constraints which the type of function symbols must--- satisfy in order to be used by twee.-type Function f = (Ordered f, Arity f, Sized f, Minimal f, Skolem f, PrettyTerm f, EqualsBonus f)---- | A hack for encoding Horn clauses. See 'Twee.CP.Score'.--- The default implementation of 'hasEqualsBonus' should work OK.-class EqualsBonus f where-  hasEqualsBonus :: f -> Bool-  hasEqualsBonus _ = False-  isEquals, isTrue, isFalse :: f -> Bool-  isEquals _ = False-  isTrue _ = False-  isFalse _ = False--instance EqualsBonus f => EqualsBonus (Fun f) where-  hasEqualsBonus = hasEqualsBonus . fun_value-  isEquals = isEquals . fun_value-  isTrue = isTrue . fun_value-  isFalse = isFalse . fun_value---- | A function symbol extended with a minimal constant and Skolem functions.--- Comes equipped with 'Minimal' and 'Skolem' instances.-data Extended f =-    -- | The minimal constant.-    Minimal-    -- | A Skolem function.-  | Skolem Var-    -- | An ordinary function symbol.-  | Function f-  deriving (Eq, Ord, Show, Functor)--instance Pretty f => Pretty (Extended f) where-  pPrintPrec _ _ Minimal = text "?"-  pPrintPrec _ _ (Skolem (V n)) = text "sk" <> pPrint n-  pPrintPrec l p (Function f) = pPrintPrec l p f--instance PrettyTerm f => PrettyTerm (Extended f) where-  termStyle (Function f) = termStyle f-  termStyle _ = uncurried--instance Sized f => Sized (Extended f) where-  size (Function f) = size f-  size _ = 1--instance Arity f => Arity (Extended f) where-  arity (Function f) = arity f-  arity _ = 0--instance (Typeable f, Ord f) => Minimal (Extended f) where-  minimal = fun Minimal--instance (Typeable f, Ord f) => Skolem (Extended f) where-  skolem x = fun (Skolem x)--instance EqualsBonus f => EqualsBonus (Extended f) where-  hasEqualsBonus (Function f) = hasEqualsBonus f-  hasEqualsBonus _ = False-  isEquals (Function f) = isEquals f-  isEquals _ = False-  isTrue (Function f) = isTrue f-  isTrue _ = False-  isFalse (Function f) = isFalse f-  isFalse _ = False
− src/Twee/CP.hs 
@@ -1,328 +0,0 @@--- | Critical pair generation.-{-# LANGUAGE BangPatterns, FlexibleContexts, ScopedTypeVariables, MultiParamTypeClasses, RecordWildCards, OverloadedStrings, TypeFamilies, GeneralizedNewtypeDeriving #-}-module Twee.CP where--import qualified Twee.Term as Term-import Twee.Base-import Twee.Rule-import Twee.Index(Index)-import qualified Data.Set as Set-import Control.Monad-import Data.Maybe-import Data.List-import qualified Data.ChurchList as ChurchList-import Data.ChurchList (ChurchList(..))-import Twee.Utils-import Twee.Equation-import qualified Twee.Proof as Proof-import Twee.Proof(Derivation, Lemma, congPath)---- | The set of positions at which a term can have critical overlaps.-data Positions f = NilP | ConsP {-# UNPACK #-} !Int !(Positions f)-type PositionsOf a = Positions (ConstantOf a)--instance Show (Positions f) where-  show = show . ChurchList.toList . positionsChurch---- | Calculate the set of positions for a term.-positions :: Term f -> Positions f-positions t = aux 0 Set.empty (singleton t)-  where-    -- Consider only general superpositions.-    aux !_ !_ Empty = NilP-    aux n m (Cons (Var _) t) = aux (n+1) m t-    aux n m (ConsSym t@App{} u)-      | t `Set.member` m = aux (n+1) m u-      | otherwise = ConsP n (aux (n+1) (Set.insert t m) u)--{-# INLINE positionsChurch #-}-positionsChurch :: Positions f -> ChurchList Int-positionsChurch posns =-  ChurchList $ \c n ->-    let-      pos NilP = n-      pos (ConsP x posns) = c x (pos posns)-    in-      pos posns---- | A critical overlap of one rule with another.-data Overlap f =-  Overlap {-    -- | The depth (1 for CPs of axioms, 2 for CPs whose rules have depth 1, etc.)-    overlap_depth :: {-# UNPACK #-} !Depth,-    -- | The critical term.-    overlap_top   :: {-# UNPACK #-} !(Term f),-    -- | The part of the critical term which the inner rule rewrites.-    overlap_inner :: {-# UNPACK #-} !(Term f),-    -- | The position in the critical term which is rewritten.-    overlap_pos   :: {-# UNPACK #-} !Int,-    -- | The critical pair itself.-    overlap_eqn   :: {-# UNPACK #-} !(Equation f) }-  deriving Show-type OverlapOf a = Overlap (ConstantOf a)---- | Represents the depth of a critical pair.-newtype Depth = Depth Int deriving (Eq, Ord, Num, Real, Enum, Integral, Show)---- | Compute all overlaps of a rule with a set of rules.-{-# INLINEABLE overlaps #-}-overlaps ::-  (Function f, Has a (Rule f), Has a (Positions f), Has a Depth) =>-  Depth -> Index f a -> [a] -> a -> [(a, a, Overlap f)]-overlaps max_depth idx rules r =-  ChurchList.toList (overlapsChurch max_depth idx rules r)--{-# INLINE overlapsChurch #-}-overlapsChurch :: forall f a.-  (Function f, Has a (Rule f), Has a (Positions f), Has a Depth) =>-  Depth -> Index f a -> [a] -> a -> ChurchList (a, a, Overlap f)-overlapsChurch max_depth idx rules r1 = do-  guard (the r1 < max_depth)-  r2 <- ChurchList.fromList rules-  guard (the r2 < max_depth)-  let !depth = 1 + max (the r1) (the r2)-  do { o <- asymmetricOverlaps idx depth (the r1) r1' (the r2); return (r1, r2, o) } `mplus`-    do { o <- asymmetricOverlaps idx depth (the r2) (the r2) r1'; return (r2, r1, o) }-  where-    !r1' = renameAvoiding (map the rules :: [Rule f]) (the r1)--{-# INLINE asymmetricOverlaps #-}-asymmetricOverlaps ::-  (Function f, Has a (Rule f), Has a Depth) =>-  Index f a -> Depth -> Positions f -> Rule f -> Rule f -> ChurchList (Overlap f)-asymmetricOverlaps idx depth posns r1 r2 = do-  n <- positionsChurch posns-  ChurchList.fromMaybe $-    overlapAt n depth r1 r2 >>=-    simplifyOverlap idx---- | Create an overlap at a particular position in a term.--- Doesn't simplify the overlap.-{-# INLINE overlapAt #-}-overlapAt :: Int -> Depth -> Rule f -> Rule f -> Maybe (Overlap f)-overlapAt !n !depth (Rule _ !outer !outer') (Rule _ !inner !inner') = do-  let t = at n (singleton outer)-  sub <- unifyTri inner t-  let-    top = {-# SCC overlap_top #-} termSubst sub outer-    innerTerm = {-# SCC overlap_inner #-} termSubst sub inner-    -- Make sure to keep in sync with overlapProof-    lhs = {-# SCC overlap_eqn_1 #-} termSubst sub outer'-    rhs = {-# SCC overlap_eqn_2 #-}-      buildReplacePositionSub sub n (singleton inner') (singleton outer)--  guard (lhs /= rhs)-  return Overlap {-    overlap_depth = depth,-    overlap_top = top,-    overlap_inner = innerTerm,-    overlap_pos = n,-    overlap_eqn = lhs :=: rhs }---- | Simplify an overlap and remove it if it's trivial.-{-# INLINE simplifyOverlap #-}-simplifyOverlap :: (Function f, Has a (Rule f)) => Index f a -> Overlap f -> Maybe (Overlap f)-simplifyOverlap idx overlap@Overlap{overlap_eqn = lhs :=: rhs, ..}-  | lhs == rhs'  = Nothing-  | lhs' == rhs' = Nothing-  | otherwise = Just overlap{overlap_eqn = lhs' :=: rhs'}-  where-    lhs' = simplify idx lhs-    rhs' = simplify idx rhs---- Put these in separate functions to avoid code blowup-buildReplacePositionSub :: TriangleSubst f -> Int -> TermList f -> TermList f -> Term f-buildReplacePositionSub !sub !n !inner' !outer =-  build (replacePositionSub sub n inner' outer)--termSubst :: TriangleSubst f -> Term f -> Term f-termSubst sub t = build (Term.subst sub t)---- | The configuration for the critical pair weighting heuristic.-data Config =-  Config {-    cfg_lhsweight :: !Int,-    cfg_rhsweight :: !Int,-    cfg_funweight :: !Int,-    cfg_varweight :: !Int,-    cfg_depthweight :: !Int,-    cfg_dupcost :: !Int,-    cfg_dupfactor :: !Int }---- | The default heuristic configuration.-defaultConfig :: Config-defaultConfig =-  Config {-    cfg_lhsweight = 3,-    cfg_rhsweight = 1,-    cfg_funweight = 7,-    cfg_varweight = 6,-    cfg_depthweight = 16,-    cfg_dupcost = 7,-    cfg_dupfactor = 0 }---- | Compute a score for a critical pair.---- We compute:---   cfg_lhsweight * size l + cfg_rhsweight * size r--- where l is the biggest term and r is the smallest,--- and variables have weight 1 and functions have weight cfg_funweight.-{-# INLINEABLE score #-}-score :: Function f => Config -> Overlap f -> Int-score Config{..} Overlap{..} =-  fromIntegral overlap_depth * cfg_depthweight +-  (m + n) * cfg_rhsweight +-  intMax m n * (cfg_lhsweight - cfg_rhsweight)-  where-    l :=: r = overlap_eqn-    m = size' 0 (singleton l)-    n = size' 0 (singleton r)--    size' !n Empty = n-    size' n (Cons t ts)-      | len t > 1, t `isSubtermOfList` ts =-        size' (n+cfg_dupcost+cfg_dupfactor*size t) ts-    size' n ts-      | Cons (App f (Cons a (Cons b us))) vs <- ts,-        hasEqualsBonus (fun_value f), isJust (unify a b) =-        size' (size' (n+1) us) vs-    size' n (Cons (Var _) ts) =-      size' (n+cfg_varweight) ts-    size' n (ConsSym (App f _) ts) =-      size' (n+cfg_funweight*size f) ts--------------------------------------------------------------------------- * Higher-level handling of critical pairs.--------------------------------------------------------------------------- | A critical pair together with information about how it was derived-data CriticalPair f =-  CriticalPair {-    -- | The critical pair itself.-    cp_eqn   :: {-# UNPACK #-} !(Equation f),-    -- | The depth of the critical pair.-    cp_depth :: {-# UNPACK #-} !Depth,-    -- | The critical term, if there is one.-    -- (Axioms do not have a critical term.)-    cp_top   :: !(Maybe (Term f)),-    -- | A derivation of the critical pair from the axioms.-    cp_proof :: !(Derivation f) }--instance Symbolic (CriticalPair f) where-  type ConstantOf (CriticalPair f) = f-  termsDL CriticalPair{..} =-    termsDL cp_eqn `mplus` termsDL cp_top `mplus` termsDL cp_proof-  subst_ sub CriticalPair{..} =-    CriticalPair {-      cp_eqn = subst_ sub cp_eqn,-      cp_depth = cp_depth,-      cp_top = subst_ sub cp_top,-      cp_proof = subst_ sub cp_proof }--instance PrettyTerm f => Pretty (CriticalPair f) where-  pPrint CriticalPair{..} =-    vcat [-      pPrint cp_eqn,-      nest 2 (text "top:" <+> pPrint cp_top) ]---- | Split a critical pair so that it can be turned into rules.------ The resulting critical pairs have the property that no variable appears on--- the right that is not on the left.---- See the comment below.-split :: Function f => CriticalPair f -> [CriticalPair f]-split CriticalPair{cp_eqn = l :=: r, ..}-  | l == r = []-  | otherwise =-    -- If we have something which is almost a rule, except that some-    -- variables appear only on the right-hand side, e.g.:-    --   f x y -> g x z-    -- then we replace it with the following two rules:-    --   f x y -> g x ?-    --   g x z -> g x ?-    -- where the second rule is weakly oriented and ? is the minimal-    -- constant.-    ---    -- If we have an unoriented equation with a similar problem, e.g.:-    --   f x y = g x z-    -- then we replace it with potentially three rules:-    --   f x ? = g x ?-    --   f x y -> f x ?-    --   g x z -> g x ?--    -- The main rule l -> r' or r -> l' or l' = r'-    [ CriticalPair {-        cp_eqn   = l :=: r',-        cp_depth = cp_depth,-        cp_top   = eraseExcept (vars l) cp_top,-        cp_proof = eraseExcept (vars l) cp_proof }-    | ord == Just GT ] ++-    [ CriticalPair {-        cp_eqn   = r :=: l',-        cp_depth = cp_depth,-        cp_top   = eraseExcept (vars r) cp_top,-        cp_proof = Proof.symm (eraseExcept (vars r) cp_proof) }-    | ord == Just LT ] ++-    [ CriticalPair {-        cp_eqn   = l' :=: r',-        cp_depth = cp_depth,-        cp_top   = eraseExcept (vars l) $ eraseExcept (vars r) cp_top,-        cp_proof = eraseExcept (vars l) $ eraseExcept (vars r) cp_proof }-    | ord == Nothing ] ++--    -- Weak rules l -> l' or r -> r'-    [ CriticalPair {-        cp_eqn   = l :=: l',-        cp_depth = cp_depth + 1,-        cp_top   = Nothing,-        cp_proof = cp_proof `Proof.trans` Proof.symm (erase ls cp_proof) }-    | not (null ls), ord /= Just GT ] ++-    [ CriticalPair {-        cp_eqn   = r :=: r',-        cp_depth = cp_depth + 1,-        cp_top   = Nothing,-        cp_proof = Proof.symm cp_proof `Proof.trans` erase rs cp_proof }-    | not (null rs), ord /= Just LT ]-    where-      ord = orientTerms l' r'-      l' = erase ls l-      r' = erase rs r-      ls = usort (vars l) \\ usort (vars r)-      rs = usort (vars r) \\ usort (vars l)--      eraseExcept vs t =-        erase (usort (vars t) \\ usort vs) t---- | Make a critical pair from two rules and an overlap.-{-# INLINEABLE makeCriticalPair #-}-makeCriticalPair ::-  (Has a (Rule f), Has a (Lemma f), Has a Id, Function f) =>-  a -> a -> Overlap f -> Maybe (CriticalPair f)-makeCriticalPair r1 r2 overlap@Overlap{..}-  | lessEq overlap_top t = Nothing-  | lessEq overlap_top u = Nothing-  | otherwise =-    Just $-      CriticalPair overlap_eqn-        overlap_depth-        (Just overlap_top)-        (overlapProof r1 r2 overlap)-  where-    t :=: u = overlap_eqn---- | Return a proof for a critical pair.-{-# INLINEABLE overlapProof #-}-overlapProof ::-  forall a f.-  (Has a (Rule f), Has a (Lemma f), Has a Id) =>-  a -> a -> Overlap f -> Derivation f-overlapProof left right Overlap{..} =-  Proof.symm (reductionProof (step left leftSub))-  `Proof.trans`-  congPath path overlap_top (reductionProof (step right rightSub))-  where-    Just leftSub = match (lhs (the left)) overlap_top-    Just rightSub = match (lhs (the right)) overlap_inner--    path = positionToPath (lhs (the left) :: Term f) overlap_pos
− src/Twee/Constraints.hs 
@@ -1,312 +0,0 @@-{-# LANGUAGE FlexibleContexts, UndecidableInstances, RecordWildCards #-}--- | Solving constraints on variable ordering.-module Twee.Constraints where----import Twee.Base hiding (equals, Term, pattern Fun, pattern Var, lookup, funs)-import qualified Twee.Term as Flat-import qualified Data.Map.Strict as Map-import Twee.Pretty hiding (equals)-import Twee.Utils-import Data.Maybe-import Data.List-import Data.Function-import Data.Graph-import Data.Map.Strict(Map)-import Data.Ord-import Twee.Term hiding (lookup)--data Atom f = Constant (Fun f) | Variable Var deriving (Show, Eq, Ord)--{-# INLINE atoms #-}-atoms :: Term f -> [Atom f]-atoms t = aux (singleton t)-  where-    aux Empty = []-    aux (Cons (App f Empty) t) = Constant f:aux t-    aux (Cons (Var x) t) = Variable x:aux t-    aux (ConsSym _ t) = aux t--toTerm :: Atom f -> Term f-toTerm (Constant f) = build (con f)-toTerm (Variable x) = build (var x)--fromTerm :: Flat.Term f -> Maybe (Atom f)-fromTerm (App f Empty) = Just (Constant f)-fromTerm (Var x) = Just (Variable x)-fromTerm _ = Nothing--instance PrettyTerm f => Pretty (Atom f) where-  pPrint = pPrint . toTerm--data Formula f =-    Less   (Atom f) (Atom f)-  | LessEq (Atom f) (Atom f)-  | And [Formula f]-  | Or  [Formula f]-  deriving (Eq, Ord, Show)--instance PrettyTerm f => Pretty (Formula f) where-  pPrintPrec _ _ (Less t u) = hang (pPrint t <+> text "<") 2 (pPrint u)-  pPrintPrec _ _ (LessEq t u) = hang (pPrint t <+> text "<=") 2 (pPrint u)-  pPrintPrec _ _ (And []) = text "true"-  pPrintPrec _ _ (Or []) = text "false"-  pPrintPrec l p (And xs) =-    maybeParens (p > 10)-      (fsep (punctuate (text " &") (nest_ (map (pPrintPrec l 11) xs))))-    where-      nest_ (x:xs) = x:map (nest 2) xs-      nest_ [] = undefined-  pPrintPrec l p (Or xs) =-    maybeParens (p > 10)-      (fsep (punctuate (text " |") (nest_ (map (pPrintPrec l 11) xs))))-    where-      nest_ (x:xs) = x:map (nest 2) xs-      nest_ [] = undefined--negateFormula :: Formula f -> Formula f-negateFormula (Less t u) = LessEq u t-negateFormula (LessEq t u) = Less u t-negateFormula (And ts) = Or (map negateFormula ts)-negateFormula (Or ts) = And (map negateFormula ts)--conj forms-  | false `elem` forms' = false-  | otherwise =-    case forms' of-      [x] -> x-      xs  -> And xs-  where-    flatten (And xs) = xs-    flatten x = [x]-    forms' = filter (/= true) (usort (concatMap flatten forms))-disj forms-  | true `elem` forms' = true-  | otherwise =-    case forms' of-      [x] -> x-      xs  -> Or xs-  where-    flatten (Or xs) = xs-    flatten x = [x]-    forms' = filter (/= false) (usort (concatMap flatten forms))--x &&& y = conj [x, y]-x ||| y = disj [x, y]-true  = And []-false = Or []--data Branch f =-  -- Branches are kept normalised wrt equals-  Branch {-    funs        :: [Fun f],-    less        :: [(Atom f, Atom f)],  -- sorted-    equals      :: [(Atom f, Atom f)] } -- sorted, greatest atom first in each pair-  deriving (Eq, Ord)--instance PrettyTerm f => Pretty (Branch f) where-  pPrint Branch{..} =-    braces $ fsep $ punctuate (text ",") $-      [pPrint x <+> text "<" <+> pPrint y | (x, y) <- less ] ++-      [pPrint x <+> text "=" <+> pPrint y | (x, y) <- equals ]--trueBranch :: Branch f-trueBranch = Branch [] [] []--norm :: Eq f => Branch f -> Atom f -> Atom f-norm Branch{..} x = fromMaybe x (lookup x equals)--contradictory :: (Minimal f, Ord f) => Branch f -> Bool-contradictory Branch{..} =-  or [f == minimal | (_, Constant f) <- less] ||-  or [f /= g | (Constant f, Constant g) <- equals] ||-  any cyclic (stronglyConnComp-    [(x, x, [y | (x', y) <- less, x == x']) | x <- usort (map fst less)])-  where-    cyclic (AcyclicSCC _) = False-    cyclic (CyclicSCC _) = True--formAnd :: (Minimal f, Ordered f) => Formula f -> [Branch f] -> [Branch f]-formAnd f bs = usort (bs >>= add f)-  where-    add (Less t u) b = addLess t u b-    add (LessEq t u) b = addLess t u b ++ addEquals t u b-    add (And []) b = [b]-    add (And (f:fs)) b = add f b >>= add (And fs)-    add (Or fs) b = usort (concat [ add f b | f <- fs ])--branches :: (Minimal f, Ordered f) => Formula f -> [Branch f]-branches x = aux [x]-  where-    aux [] = [Branch [] [] []]-    aux (And xs:ys) = aux (xs ++ ys)-    aux (Or xs:ys) = usort $ concat [aux (x:ys) | x <- xs]-    aux (Less t u:xs) = usort $ concatMap (addLess t u) (aux xs)-    aux (LessEq t u:xs) =-      usort $-      concatMap (addLess t u) (aux xs) ++-      concatMap (addEquals u t) (aux xs)--addLess :: (Minimal f, Ordered f) => Atom f -> Atom f -> Branch f -> [Branch f]-addLess _ (Constant min) _ | min == minimal = []-addLess (Constant min) _ b | min == minimal = [b]-addLess t0 u0 b@Branch{..} =-  filter (not . contradictory)-    [addTerm t (addTerm u b{less = usort ((t, u):less)})]-  where-    t = norm b t0-    u = norm b u0--addEquals :: (Minimal f, Ordered f) => Atom f -> Atom f -> Branch f -> [Branch f]-addEquals t0 u0 b@Branch{..}-  | t == u || (t, u) `elem` equals = [b]-  | otherwise =-    filter (not . contradictory)-      [addTerm t (addTerm u b {-         equals      = usort $ (t, u):[(x', y') | (x, y) <- equals, let (y', x') = sort2 (sub x, sub y), x' /= y'],-         less        = usort $ [(sub x, sub y) | (x, y) <- less] })]-  where-    sort2 (x, y) = (min x y, max x y)-    (u, t) = sort2 (norm b t0, norm b u0)--    sub x-      | x == t = u-      | otherwise = x--addTerm :: (Minimal f, Ordered f) => Atom f -> Branch f -> Branch f-addTerm (Constant f) b-  | f `notElem` funs b =-    b {-      funs = f:funs b,-      less =-        usort $-          [ (Constant f, Constant g) | g <- funs b, f << g ] ++-          [ (Constant g, Constant f) | g <- funs b, g << f ] ++ less b }-addTerm _ b = b--newtype Model f = Model (Map (Atom f) (Int, Int))-  deriving (Eq, Show)--- Representation: map from atom to (major, minor)--- x <  y if major x < major y--- x <= y if major x = major y and minor x < minor y--instance PrettyTerm f => Pretty (Model f) where-  pPrint (Model m)-    | Map.size m <= 1 = text "empty"-    | otherwise = fsep (go (sortBy (comparing snd) (Map.toList m)))-      where-        go [(x, _)] = [pPrint x]-        go ((x, (i, _)):xs@((_, (j, _)):_)) =-          (pPrint x <+> text rel):go xs-          where-            rel = if i == j then "<=" else "<"--modelToLiterals :: Model f -> [Formula f]-modelToLiterals (Model m) = go (sortBy (comparing snd) (Map.toList m))-  where-    go []  = []-    go [_] = []-    go ((x, (i, _)):xs@((y, (j, _)):_)) =-      rel x y:go xs-      where-        rel = if i == j then LessEq else Less--modelFromOrder :: (Minimal f, Ord f) => [Atom f] -> Model f-modelFromOrder xs =-  Model (Map.fromList [(x, (i, i)) | (x, i) <- zip xs [0..]])--weakenModel :: Model f -> [Model f]-weakenModel (Model m) =-  [ Model (Map.delete x m) | x <- Map.keys m ] ++-  [ Model (Map.fromList xs)-  | xs <- glue (sortBy (comparing snd) (Map.toList m)),-    all ok (groupBy ((==) `on` (fst . snd)) xs) ]-  where-    glue [] = []-    glue [_] = []-    glue (a@(_x, (i1, j1)):b@(y, (i2, _)):xs) =-      [ (a:(y, (i1, j1+1)):xs) | i1 < i2 ] ++-      map (a:) (glue (b:xs))--    -- We must never make two constants equal-    ok xs = length [x | (Constant x, _) <- xs] <= 1--varInModel :: (Minimal f, Ord f) => Model f -> Var -> Bool-varInModel (Model m) x = Variable x `Map.member` m--varGroups :: (Minimal f, Ord f) => Model f -> [(Fun f, [Var], Maybe (Fun f))]-varGroups (Model m) = filter nonempty (go minimal (map fst (sortBy (comparing snd) (Map.toList m))))-  where-    go f xs =-      case span isVariable xs of-        (_, []) -> [(f, map unVariable xs, Nothing)]-        (ys, Constant g:zs) ->-          (f, map unVariable ys, Just g):go g zs-    isVariable (Constant _) = False-    isVariable (Variable _) = True-    unVariable (Variable x) = x-    nonempty (_, [], _) = False-    nonempty _ = True--class Minimal f where-  minimal :: Fun f--{-# INLINE lessEqInModel #-}-lessEqInModel :: (Minimal f, Ordered f) => Model f -> Atom f -> Atom f -> Maybe Strictness-lessEqInModel (Model m) x y-  | Just (a, _) <- Map.lookup x m,-    Just (b, _) <- Map.lookup y m,-    a < b = Just Strict-  | Just a <- Map.lookup x m,-    Just b <- Map.lookup y m,-    a < b = Just Nonstrict-  | x == y = Just Nonstrict-  | Constant a <- x, Constant b <- y, a << b = Just Strict-  | Constant a <- x, a == minimal = Just Nonstrict-  | otherwise = Nothing--solve :: (Minimal f, Ordered f, PrettyTerm f) => [Atom f] -> Branch f -> Either (Model f) (Subst f)-solve xs branch@Branch{..}-  | null equals && not (all true less) =-    error $ "Model " ++ prettyShow model ++ " is not a model of " ++ prettyShow branch ++ " (edges = " ++ prettyShow edges ++ ", vs = " ++ prettyShow vs ++ ")"-  | null equals = Left model-  | otherwise = Right sub-    where-      sub = fromMaybe undefined . listToSubst $-        [(x, toTerm y) | (Variable x, y) <- equals] ++-        [(y, toTerm x) | (x@Constant{}, Variable y) <- equals]-      vs = Constant minimal:reverse (flattenSCCs (stronglyConnComp edges))-      edges = [(x, x, [y | (x', y) <- less', x == x']) | x <- as, x /= Constant minimal]-      less' = less ++ [(Constant x, Constant y) | Constant x <- as, Constant y <- as, x << y]-      as = usort $ xs ++ map fst less ++ map snd less-      model = modelFromOrder vs-      true (t, u) = lessEqInModel model t u == Just Strict--class Ord f => Ordered f where-  -- | Return 'True' if the first term is less than or equal to the second,-  -- in the term ordering.-  lessEq :: Term f -> Term f -> Bool-  -- | Check if the first term is less than or equal to the second in the given model,-  -- and decide whether the inequality is strict or nonstrict.-  lessIn :: Model f -> Term f -> Term f -> Maybe Strictness---- | Describes whether an inequality is strict or nonstrict.-data Strictness =-    -- | The first term is strictly less than the second.-    Strict-    -- | The first term is less than or equal to the second.-  | Nonstrict deriving (Eq, Show)---- | Return 'True' if the first argument is strictly less than the second,--- in the term ordering.-lessThan :: Ordered f => Term f -> Term f -> Bool-lessThan t u = lessEq t u && isNothing (unify t u)---- | Return the direction in which the terms are oriented according to the term--- ordering, or 'Nothing' if they cannot be oriented. A result of @'Just' 'LT'@--- means that the first term is less than /or equal to/ the second.-orientTerms :: Ordered f => Term f -> Term f -> Maybe Ordering-orientTerms t u-  | t == u = Just EQ-  | lessEq t u = Just LT-  | lessEq u t = Just GT-  | otherwise = Nothing
− src/Twee/Equation.hs 
@@ -1,58 +0,0 @@--- | Equations.-{-# LANGUAGE TypeFamilies #-}-module Twee.Equation where--import Twee.Base-import Data.Maybe-import Control.Monad------------------------------------------------------------------------------------- * Equations.-----------------------------------------------------------------------------------data Equation f =-  (:=:) {-    eqn_lhs :: {-# UNPACK #-} !(Term f),-    eqn_rhs :: {-# UNPACK #-} !(Term f) }-  deriving (Eq, Ord, Show)-type EquationOf a = Equation (ConstantOf a)--instance Symbolic (Equation f) where-  type ConstantOf (Equation f) = f-  termsDL (t :=: u) = termsDL t `mplus` termsDL u-  subst_ sub (t :=: u) = subst_ sub t :=: subst_ sub u--instance PrettyTerm f => Pretty (Equation f) where-  pPrint (x :=: y) = pPrint x <+> text "=" <+> pPrint y--instance Sized f => Sized (Equation f) where-  size (x :=: y) = size x + size y---- | Order an equation roughly left-to-right.--- However, there is no guarantee that the result is oriented.-order :: Function f => Equation f -> Equation f-order (l :=: r)-  | l == r = l :=: r-  | otherwise =-    case compare (size l) (size r) of-      LT -> r :=: l-      GT -> l :=: r-      EQ -> if lessEq l r then r :=: l else l :=: r---- | Apply a function to both sides of an equation.-bothSides :: (Term f -> Term f') -> Equation f -> Equation f'-bothSides f (t :=: u) = f t :=: f u---- | Is an equation of the form t = t?-trivial :: Eq f => Equation f -> Bool-trivial (t :=: u) = t == u--simplerThan :: Function f => Equation f -> Equation f -> Bool-eq1 `simplerThan` eq2 =-  t1 `lessEq` t2 &&-  (isNothing (unify t1 t2) || (u1 `lessEq` u2))-  where-    t1 :=: u1 = skolemise eq1-    t2 :=: u2 = skolemise eq2--    skolemise = subst (con . skolem)
− src/Twee/Index.hs 
@@ -1,310 +0,0 @@--- | A term index to accelerate matching.--- An index is a multimap from terms to arbitrary values.------ The type of query supported is: given a search term, find all keys such that--- the search term is an instance of the key, and return the corresponding--- values.--{-# LANGUAGE BangPatterns, RecordWildCards, OverloadedStrings, FlexibleContexts #-}--- We get some bogus warnings because of pattern synonyms.-{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}-module Twee.Index(-  Index,-  empty,-  null,-  singleton,-  insert,-  delete,-  lookup,-  matches,-  approxMatches,-  elems) where--import qualified Prelude-import Prelude hiding (null, lookup)-import Data.Maybe-import Twee.Base hiding (var, fun, empty, size, singleton, prefix, funs, lookupList, lookup)-import qualified Twee.Term as Term-import Twee.Term.Core(TermList(..))-import Data.DynamicArray-import qualified Data.List as List---- The term index in this module is an _imperfect discrimination tree_.--- This is a trie whose keys are terms, represented as flat lists of symbols,--- but where all variables have been replaced by a single don't-care variable '_'.--- That is, the edges of the trie can be either function symbols or '_'.--- To insert a key-value pair into the discrimination tree, we first replace all--- variables in the key with '_', and then do ordinary trie insertion.------ Lookup maintains a term list, which is initially the search term.--- It proceeds down the trie, consuming bits of the term list as it goes.------ If the current trie node has an edge for a function symbol f, and the term at--- the head of the term list is f(t1..tn), we can follow the f edge. We then--- delete f from the term list, but keep t1..tn at the front of the term list.--- (In other words we delete only the symbol f and not its arguments.)------ If the current trie node has an edge for '_', we can always follow that edge.--- We then remove the head term from the term list, as the '_' represents a--- variable that should match that whole term.------ If the term list ever becomes empty, we have a possible match. We then--- do matching on the values stored at the current node to see if they are--- genuine matches.------ Often there are two edges we can follow (function symbol and '_'), and in--- that case the algorithm uses backtracking.---- | A term index: a multimap from @'Term' f@ to @a@.-data Index f a =-  -- A non-empty index.-  Index {-    -- Size of smallest term in index.-    size   :: {-# UNPACK #-} !Int,-    -- When all keys in the index start with the same sequence of symbols, we-    -- compress them into this prefix; the "fun" and "var" fields below refer to-    -- the first symbol _after_ the prefix, and the "here" field contains values-    -- whose remaining key is exactly this prefix.-    prefix :: {-# UNPACK #-} !(TermList f),-    -- The values that are found at this node.-    here   :: [a],-    -- Function symbol edges.-    -- The array is indexed by function number.-    fun    :: {-# UNPACK #-} !(Array (Index f a)),-    -- Variable edge.-    var    :: !(Index f a) } |-  -- An empty index.-  Nil-  deriving Show--instance Default (Index f a) where def = Nil---- To get predictable performance, the lookup function uses an explicit stack--- instead of recursion to control backtracking.-data Stack f a =-  -- A normal stack frame: records the current index node and term.-  Frame {-    frame_term  :: {-# UNPACK #-} !(TermList f),-    frame_index :: !(Index f a),-    frame_rest  :: !(Stack f a) }-  -- A stack frame which is used when we have found a match.-  | Yield {-    yield_found :: [a],-    yield_rest  :: !(Stack f a) }-  -- End of stack.-  | Stop---- Turn a stack into a list of results.-run :: Stack f a -> [a]-run Stop = []-run Frame{..} = run ({-# SCC run_inner #-} step frame_term frame_index frame_rest)-run Yield{..} = {-# SCC run_found #-} yield_found ++ run yield_rest---- Execute a single stack frame.-{-# INLINE step #-}-step :: TermList f -> Index f a -> Stack f a -> Stack f a-step !_ _ _ | False = undefined-step t idx rest =-  case idx of-    Nil -> rest-    Index{..}-      | lenList t < size ->-        rest -- the search term is smaller than any in this index-      | otherwise ->-        pref t prefix here fun var rest---- The main work of 'step' goes on here.--- It is carefully tweaked to generate nice code,--- including using UnsafeCons and only casing on each--- term list exactly once.-pref :: TermList f -> TermList f -> [a] -> Array (Index f a) -> Index f a -> Stack f a -> Stack f a-pref !_ !_ _ !_ !_ _ | False = undefined-pref search prefix here fun var rest =-  case search of-    Empty ->-      case prefix of-        Empty ->-          -- The search term matches this node.-          case here of-            [] -> rest-            _ -> Yield here rest-        _ ->-          -- We've run out of search term - it doesn't match this node.-          rest-    UnsafeCons t ts ->-      case prefix of-        Cons u us ->-          -- Check the search term against the prefix.-          case (t, u) of-            (_, Var _) ->-              -- Prefix contains a variable - if there is a match, the-              -- variable will be bound to t.-              pref ts us here fun var rest-            (App f _, App g _) | f == g ->-              -- Term and prefix start with same symbol, chop them off.-               let-                 UnsafeConsSym _ ts' = search-                 UnsafeConsSym _ us' = prefix-               in pref ts' us' here fun var rest-            _ ->-              -- Term and prefix don't match.-              rest-        _ ->-          -- We've exhausted the prefix, so let's descend into the tree.-          -- Seems to work better to explore the function node first.-          let-            tryVar =-              case var of-                Nil -> rest-                Index{} -> Frame ts var rest-              where-                UnsafeCons _ ts = search--            tryFun =-              case t of-                App f _ ->-                  case fun ! fun_id f of-                    Nil -> tryVar-                    idx -> Frame ts idx $! tryVar-                _ ->-                  tryVar-              where-                UnsafeConsSym t ts = search-          in-            tryFun---- | An empty index.-empty :: Index f a-empty = Nil---- | Is the index empty?-null :: Index f a -> Bool-null Nil = True-null _ = False---- | An index with one entry.-singleton :: Term f -> a -> Index f a-singleton !t x = singletonList (Term.singleton t) x---- An index with one entry, giving a termlist instead of a term.-{-# INLINE singletonList #-}-singletonList :: TermList f -> a -> Index f a-singletonList t x = Index 0 t [x] newArray Nil---- | Insert an entry into the index.-insert :: Term f -> a -> Index f a -> Index f a-insert !t x !idx = {-# SCC insert #-} aux (Term.singleton t) idx-  where-    aux t Nil = singletonList t x-    aux (Cons t ts) idx@Index{prefix = Cons u us} | t == u =-      withPrefix (Term.singleton t) (aux ts idx{prefix = us})-    aux t idx@Index{prefix = Cons{}} = aux t (expand idx)--    aux Empty idx =-      idx { size = 0, here = x:here idx }-    aux t@(ConsSym (App f _) u) idx =-      idx {-        size = lenList t `min` size idx,-        fun  = update (fun_id f) idx' (fun idx) }-      where-        idx' = aux u (fun idx ! fun_id f)-    aux t@(ConsSym (Var _) u) idx =-      idx {-        size = lenList t `min` size idx,-        var  = aux u (var idx) }---- Add a prefix to an index.--- Does not update the size field.-{-# INLINE withPrefix #-}-withPrefix :: TermList f -> Index f a -> Index f a-withPrefix Empty idx = idx-withPrefix _ Nil = Nil-withPrefix t idx@Index{..} =-  idx{prefix = buildList (builder t `mappend` builder prefix)}---- Take an index with a prefix and pull out the first symbol of the prefix,--- giving an index which doesn't start with a prefix.-{-# INLINE expand #-}-expand :: Index f a -> Index f a-expand idx@Index{size = size, prefix = ConsSym t ts} =-  case t of-    Var _ ->-      Index {-        size = size,-        prefix = Term.empty,-        here = [],-        fun = newArray,-        var = idx { prefix = ts, size = size - 1 } }-    App f _ ->-      Index {-        size = size,-        prefix = Term.empty,-        here = [],-        fun = update (fun_id f) idx { prefix = ts, size = size - 1 } newArray,-        var = Nil }---- | Delete an entry from the index.-{-# INLINEABLE delete #-}-delete :: Eq a => Term f -> a -> Index f a -> Index f a-delete !t x !idx = {-# SCC delete #-} aux (Term.singleton t) idx-  where-    aux _ Nil = Nil-    aux (Cons t ts) idx@Index{prefix = Cons u us} | t == u =-      withPrefix (Term.singleton t) (aux ts idx{prefix = us})-    aux _ idx@Index{prefix = Cons{}} = idx--    aux Empty idx-      | x `List.elem` here idx =-        idx { here = List.delete x (here idx) }-      | otherwise =-        error "deleted term not found in index"-    aux (ConsSym (App f _) t) idx =-      idx { fun = update (fun_id f) (aux t (fun idx ! fun_id f)) (fun idx) }-    aux (ConsSym (Var _) t) idx =-      idx { var = aux t (var idx) }---- | Look up a term in the index. Finds all key-value such that the search term--- is an instance of the key, and returns an instance of the the value which--- makes the search term exactly equal to the key.-{-# INLINE lookup #-}-lookup :: (Has a b, Symbolic b, Has b (TermOf b)) => TermOf b -> Index (ConstantOf b) a -> [b]-lookup t idx = lookupList (Term.singleton t) idx--{-# INLINEABLE lookupList #-}-lookupList :: (Has a b, Symbolic b, Has b (TermOf b)) => TermListOf b -> Index (ConstantOf b) a -> [b]-lookupList t idx =-  [ subst sub x-  | x <- List.map the (approxMatchesList t idx),-    sub <- maybeToList (matchList (Term.singleton (the x)) t)]---- | Look up a term in the index. Like 'lookup', but returns the exact value--- that was inserted into the index, not an instance. Also returns a substitution--- which when applied to the value gives you the matching instance.-{-# INLINE matches #-}-matches :: Has a (Term f) => Term f -> Index f a -> [(Subst f, a)]-matches t idx = matchesList (Term.singleton t) idx--{-# INLINEABLE matchesList #-}-matchesList :: Has a (Term f) => TermList f -> Index f a -> [(Subst f, a)]-matchesList t idx =-  [ (sub, x)-  | x <- approxMatchesList t idx,-    sub <- maybeToList (matchList (Term.singleton (the x)) t)]---- | Look up a term in the index, possibly returning spurious extra results.-{-# INLINE approxMatches #-}-approxMatches :: Term f -> Index f a -> [a]-approxMatches t idx = approxMatchesList (Term.singleton t) idx--approxMatchesList :: TermList f -> Index f a -> [a]-approxMatchesList t idx =-  {-# SCC approxMatchesList #-}-  run (Frame t idx Stop)---- | Return all elements of the index.-elems :: Index f a -> [a]-elems Nil = []-elems idx =-  here idx ++-  concatMap elems (Prelude.map snd (toList (fun idx))) ++-  elems (var idx)
− src/Twee/Join.hs 
@@ -1,212 +0,0 @@--- | Tactics for joining critical pairs.-{-# LANGUAGE FlexibleContexts, BangPatterns, RecordWildCards, TypeFamilies #-}-module Twee.Join where--import Twee.Base-import Twee.Rule-import Twee.Equation-import Twee.Proof(Lemma)-import qualified Twee.Proof as Proof-import Twee.CP hiding (Config)-import Twee.Constraints-import qualified Twee.Index as Index-import Twee.Index(Index)-import Twee.Rule.Index(RuleIndex(..))-import Twee.Utils-import Data.Maybe-import Data.Either-import Data.Ord-import qualified Data.Set as Set--data Config =-  Config {-    cfg_ground_join :: !Bool,-    cfg_use_connectedness :: !Bool,-    cfg_set_join :: !Bool }--defaultConfig :: Config-defaultConfig =-  Config {-    cfg_ground_join = True,-    cfg_use_connectedness = True,-    cfg_set_join = False }--{-# INLINEABLE joinCriticalPair #-}-joinCriticalPair ::-  (Function f, Has a (Rule f), Has a (Lemma f)) =>-  Config ->-  Index f (Equation f) -> RuleIndex f a ->-  Maybe (Model f) -> -- A model to try before checking ground joinability-  CriticalPair f ->-  Either-    -- Failed to join critical pair.-    -- Returns simplified critical pair and model in which it failed to hold.-    (CriticalPair f, Model f)-    -- Split critical pair into several instances.-    -- Returns list of instances which must be joined,-    -- and an optional equation which can be added to the joinable set-    -- after successfully joining all instances.-    (Maybe (CriticalPair f), [CriticalPair f])-joinCriticalPair config eqns idx mmodel cp@CriticalPair{cp_eqn = t :=: u} =-  {-# SCC joinCriticalPair #-}-  case allSteps config eqns idx cp of-    Nothing ->-      Right (Nothing, [])-    _ | cfg_set_join config &&-        not (null $ Set.intersection-          (normalForms (rewrite reduces (index_all idx)) [reduce (Refl t)])-          (normalForms (rewrite reduces (index_all idx)) [reduce (Refl u)])) ->-      Right (Just cp, [])-    Just cp ->-      case groundJoinFromMaybe config eqns idx mmodel (branches (And [])) cp of-        Left model -> Left (cp, model)-        Right cps -> Right (Just cp, cps)--{-# INLINEABLE step1 #-}-{-# INLINEABLE step2 #-}-{-# INLINEABLE step3 #-}-{-# INLINEABLE allSteps #-}-step1, step2, step3, allSteps ::-  (Function f, Has a (Rule f), Has a (Lemma f)) =>-  Config -> Index f (Equation f) -> RuleIndex f a -> CriticalPair f -> Maybe (CriticalPair f)-allSteps config eqns idx cp =-  step1 config eqns idx cp >>=-  step2 config eqns idx >>=-  step3 config eqns idx-step1 _ eqns idx = joinWith eqns idx (\t _ -> normaliseWith (const True) (rewrite reducesOriented (index_oriented idx)) t)-step2 _ eqns idx = joinWith eqns idx (\t _ -> normaliseWith (const True) (rewrite reduces (index_all idx)) t)-step3 Config{..} eqns idx cp-  | not cfg_use_connectedness = Just cp-  | otherwise =-    case cp_top cp of-      Just top ->-        case (join (cp, top), join (flipCP (cp, top))) of-          (Just _, Just _) -> Just cp-          _ -> Nothing-      _ -> Just cp-  where-    join (cp, top) =-      joinWith eqns idx (\t u -> normaliseWith (`lessThan` top) (rewrite (ok t u) (index_all idx)) t) cp--    ok t u rule sub =-      unorient rule `simplerThan` (t :=: u) &&-      reducesSkolem rule sub--    flipCP :: Symbolic a => a -> a-    flipCP t = subst sub t-      where-        n = maximum (0:map fromEnum (vars t))-        sub (V x) = var (V (n - x))---{-# INLINEABLE joinWith #-}-joinWith ::-  (Has a (Rule f), Has a (Lemma f)) =>-  Index f (Equation f) -> RuleIndex f a -> (Term f -> Term f -> Resulting f) -> CriticalPair f -> Maybe (CriticalPair f)-joinWith eqns idx reduce cp@CriticalPair{cp_eqn = lhs :=: rhs, ..}-  | subsumed eqns idx eqn = Nothing-  | otherwise =-    Just cp {-      cp_eqn = eqn,-      cp_proof =-        Proof.symm (reductionProof (reduction lred)) `Proof.trans`-        cp_proof `Proof.trans`-        reductionProof (reduction rred) }-  where-    lred = reduce lhs rhs-    rred = reduce rhs lhs-    eqn = result lred :=: result rred--{-# INLINEABLE subsumed #-}-subsumed ::-  (Has a (Rule f), Has a (Lemma f)) =>-  Index f (Equation f) -> RuleIndex f a -> Equation f -> Bool-subsumed eqns idx (t :=: u)-  | t == u = True-  | or [ rhs rule == u | rule <- Index.lookup t (index_all idx) ] = True-  | or [ rhs rule == t | rule <- Index.lookup u (index_all idx) ] = True-    -- No need to do this symmetrically because addJoinable adds-    -- both orientations of each equation-  | or [ u == subst sub u'-       | t' :=: u' <- Index.approxMatches t eqns,-         sub <- maybeToList (match t' t) ] = True-subsumed eqns idx (App f ts :=: App g us)-  | f == g =-    let-      sub Empty Empty = True-      sub (Cons t ts) (Cons u us) =-        subsumed eqns idx (t :=: u) && sub ts us-      sub _ _ = error "Function used with multiple arities"-    in-      sub ts us-subsumed _ _ _ = False--{-# INLINEABLE groundJoin #-}-groundJoin ::-  (Function f, Has a (Rule f), Has a (Lemma f)) =>-  Config -> Index f (Equation f) -> RuleIndex f a -> [Branch f] -> CriticalPair f -> Either (Model f) [CriticalPair f]-groundJoin config eqns idx ctx cp@CriticalPair{cp_eqn = t :=: u, ..} =-  case partitionEithers (map (solve (usort (atoms t ++ atoms u))) ctx) of-    ([], instances) ->-      let cps = [ subst sub cp | sub <- instances ] in-      Right (usortBy (comparing (canonicalise . order . cp_eqn)) cps)-    (model:_, _) ->-      groundJoinFrom config eqns idx model ctx cp--{-# INLINEABLE groundJoinFrom #-}-groundJoinFrom ::-  (Function f, Has a (Rule f), Has a (Lemma f)) =>-  Config -> Index f (Equation f) -> RuleIndex f a -> Model f -> [Branch f] -> CriticalPair f -> Either (Model f) [CriticalPair f]-groundJoinFrom config@Config{..} eqns idx model ctx cp@CriticalPair{cp_eqn = t :=: u, ..}-  | not cfg_ground_join ||-    (modelOK model && isJust (allSteps config eqns idx cp { cp_eqn = t' :=: u' })) = Left model-  | otherwise =-      let model1 = optimise model weakenModel (\m -> not (modelOK m) || (valid m (reduction nt) && valid m (reduction nu)))-          model2 = optimise model1 weakenModel (\m -> not (modelOK m) || isNothing (allSteps config eqns idx cp { cp_eqn = result (normaliseIn m t u) :=: result (normaliseIn m u t) }))--          diag [] = Or []-          diag (r:rs) = negateFormula r ||| (weaken r &&& diag rs)-          weaken (LessEq t u) = Less t u-          weaken x = x-          ctx' = formAnd (diag (modelToLiterals model2)) ctx in--      groundJoin config eqns idx ctx' cp-  where-    normaliseIn m t u = normaliseWith (const True) (rewrite (ok t u m) (index_all idx)) t-    ok t u m rule sub =-      reducesInModel m rule sub &&-      unorient rule `simplerThan` (t :=: u)--    nt = normaliseIn model t u-    nu = normaliseIn model u t-    t' = result nt-    u' = result nu--    -- XXX not safe to exploit the top term if we then add the equation to-    -- the joinable set. (It might then be used to join a CP with an entirely-    -- different top term.)-    modelOK _ = True-{-    modelOK m =-      case cp_top of-        Nothing -> True-        Just top ->-          isNothing (lessIn m top t) && isNothing (lessIn m top u)-}--{-# INLINEABLE groundJoinFromMaybe #-}-groundJoinFromMaybe ::-  (Function f, Has a (Rule f), Has a (Lemma f)) =>-  Config -> Index f (Equation f) -> RuleIndex f a -> Maybe (Model f) -> [Branch f] -> CriticalPair f -> Either (Model f) [CriticalPair f]-groundJoinFromMaybe config eqns idx Nothing = groundJoin config eqns idx-groundJoinFromMaybe config eqns idx (Just model) = groundJoinFrom config eqns idx model--{-# INLINEABLE valid #-}-valid :: Function f => Model f -> Reduction f -> Bool-valid model red =-  and [ reducesInModel model rule sub-      | Step _ rule sub <- steps red ]--optimise :: a -> (a -> [a]) -> (a -> Bool) -> a-optimise x f p =-  case filter p (f x) of-    y:_ -> optimise y f p-    _   -> x
− src/Twee/KBO.hs 
@@ -1,121 +0,0 @@--- | An implementation of Knuth-Bendix ordering.--{-# LANGUAGE PatternGuards #-}-module Twee.KBO(lessEq, lessIn) where--import Twee.Base hiding (lessEq, lessIn)-import Data.List-import Twee.Constraints hiding (lessEq, lessIn)-import qualified Data.Map.Strict as Map-import Data.Map.Strict(Map)-import Data.Maybe-import Control.Monad---- | Check if one term is less than another in KBO.-lessEq :: Function f => Term f -> Term f -> Bool-lessEq (App f Empty) _ | f == minimal = True-lessEq (Var x) (Var y) | x == y = True-lessEq _ (Var _) = False-lessEq (Var x) t = x `elem` vars t-lessEq t@(App f ts) u@(App g us) =-  (st < su ||-   (st == su && f << g) ||-   (st == su && f == g && lexLess ts us)) &&-  xs `isSubsequenceOf` ys-  where-    lexLess Empty Empty = True-    lexLess (Cons t ts) (Cons u us)-      | t == u = lexLess ts us-      | otherwise =-        lessEq t u &&-        case unify t u of-          Nothing -> True-          Just sub-            | not (allSubst (\_ (Cons t Empty) -> isMinimal t) sub) -> error "weird term inequality"-            | otherwise -> lexLess (subst sub ts) (subst sub us)-    lexLess _ _ = error "incorrect function arity"-    xs = sort (vars t)-    ys = sort (vars u)-    st = size t-    su = size u---- | Check if one term is less than another in a given model.---- See "notes/kbo under assumptions" for how this works.--lessIn :: Function f => Model f -> Term f -> Term f -> Maybe Strictness-lessIn model t u =-  case sizeLessIn model t u of-    Nothing -> Nothing-    Just Strict -> Just Strict-    Just Nonstrict -> lexLessIn model t u--sizeLessIn :: Function f => Model f -> Term f -> Term f -> Maybe Strictness-sizeLessIn model t u =-  case minimumIn model m of-    Just l-      | l >  -k -> Just Strict-      | l == -k -> Just Nonstrict-    _ -> Nothing-  where-    (k, m) =-      foldr (addSize id)-        (foldr (addSize negate) (0, Map.empty) (subterms t))-        (subterms u)-    addSize op (App f _) (k, m) = (k + op (size f), m)-    addSize op (Var x) (k, m) = (k, Map.insertWith (+) x (op 1) m)--minimumIn :: Function f => Model f -> Map Var Int -> Maybe Int-minimumIn model t =-  liftM2 (+)-    (fmap sum (mapM minGroup (varGroups model)))-    (fmap sum (mapM minOrphan (Map.toList t)))-  where-    minGroup (lo, xs, mhi)-      | all (>= 0) sums = Just (sum coeffs * size lo)-      | otherwise =-        case mhi of-          Nothing -> Nothing-          Just hi ->-            let coeff = negate (minimum coeffs) in-            Just $-              sum coeffs * size lo +-              coeff * (size lo - size hi)-      where-        coeffs = map (\x -> Map.findWithDefault 0 x t) xs-        sums = scanr1 (+) coeffs--    minOrphan (x, k)-      | varInModel model x = Just 0-      | k < 0 = Nothing-      | otherwise = Just k--lexLessIn :: Function f => Model f -> Term f -> Term f -> Maybe Strictness-lexLessIn _ t u | t == u = Just Nonstrict-lexLessIn cond t u-  | Just a <- fromTerm t,-    Just b <- fromTerm u,-    Just x <- lessEqInModel cond a b = Just x-  | Just a <- fromTerm t,-    any isJust-      [ lessEqInModel cond a b-      | v <- properSubterms u, Just b <- [fromTerm v]] =-        Just Strict-lexLessIn cond (App f ts) (App g us)-  | f == g = loop ts us-  | f << g = Just Strict-  | otherwise = Nothing-  where-    loop Empty Empty = Just Nonstrict-    loop (Cons t ts) (Cons u us)-      | t == u = loop ts us-      | otherwise =-        case lessIn cond t u of-          Nothing -> Nothing-          Just Strict -> Just Strict-          Just Nonstrict ->-            let Just sub = unify t u in-            loop (subst sub ts) (subst sub us)-    loop _ _ = error "incorrect function arity"-lexLessIn _ t _ | isMinimal t = Just Nonstrict-lexLessIn _ _ _ = Nothing
− src/Twee/Label.hs 
@@ -1,125 +0,0 @@--- | Assignment of unique IDs to values.--- Inspired by the 'intern' package.--{-# LANGUAGE RecordWildCards, ScopedTypeVariables, BangPatterns #-}-module Twee.Label(Label, unsafeMkLabel, labelNum, label, find) where--import Data.IORef-import System.IO.Unsafe-import qualified Data.Map.Strict as Map-import Data.Map.Strict(Map)-import qualified Data.IntMap.Strict as IntMap-import Data.IntMap.Strict(IntMap)-import Data.Typeable-import GHC.Exts-import Unsafe.Coerce-import Data.Int---- | A value of type @a@ which has been given a unique ID.-newtype Label a =-  Label {-    -- | The unique ID of a label.-    labelNum :: Int32 }-  deriving (Eq, Ord, Show)---- | Construct a @'Label' a@ from its unique ID, which must be the 'labelNum' of--- an already existing 'Label'. Extremely unsafe!-unsafeMkLabel :: Int32 -> Label a-unsafeMkLabel = Label---- The global cache of labels.-{-# NOINLINE cachesRef #-}-cachesRef :: IORef Caches-cachesRef = unsafePerformIO (newIORef (Caches 0 Map.empty IntMap.empty))--data Caches =-  Caches {-    -- The next id number to assign.-    caches_nextId :: {-# UNPACK #-} !Int32,-    -- A map from values to labels.-    caches_from   :: !(Map TypeRep (Cache Any)),-    -- The reverse map from labels to values.-    caches_to     :: !(IntMap Any) }--type Cache a = Map a Int32--atomicModifyCaches :: (Caches -> (Caches, a)) -> IO a-atomicModifyCaches f = do-  -- N.B. atomicModifyIORef' ref f evaluates f ref *after* doing the-  -- compare-and-swap. This causes bad things to happen when 'label'-  -- is used reentrantly (i.e. the Ord instance itself calls label).-  -- This function only lets the swap happen if caches_nextId didn't-  -- change (i.e., no new values were inserted).-  !caches <- readIORef cachesRef-  -- First compute the update.-  let !(!caches', !x) = f caches-  -- Now see if anyone else updated the cache in between-  -- (can happen if f called 'label', or in a concurrent setting).-  ok <- atomicModifyIORef' cachesRef $ \cachesNow ->-    if caches_nextId caches == caches_nextId cachesNow-    then (caches', True)-    else (cachesNow, False)-  if ok then return x else atomicModifyCaches f---- Versions of unsafeCoerce with slightly more type checking-toAnyCache :: Cache a -> Cache Any-toAnyCache = unsafeCoerce--fromAnyCache :: Cache Any -> Cache a-fromAnyCache = unsafeCoerce--toAny :: a -> Any-toAny = unsafeCoerce--fromAny :: Any -> a-fromAny = unsafeCoerce---- | Assign a label to a value.-{-# NOINLINE label #-}-label :: forall a. (Typeable a, Ord a) => a -> Label a-label x =-  unsafeDupablePerformIO $ do-    -- Common case: label is already there.-    caches <- readIORef cachesRef-    case tryFind caches of-      Just l -> return l-      Nothing -> do-        -- Rare case: label was not there.-        x <- atomicModifyCaches $ \caches ->-          case tryFind caches of-            Just l -> (caches, l)-            Nothing ->-              insert caches-        return x--  where-    ty = typeOf x--    tryFind :: Caches -> Maybe (Label a)-    tryFind Caches{..} =-      Label <$> (Map.lookup ty caches_from >>= Map.lookup x . fromAnyCache)--    insert :: Caches -> (Caches, Label a)-    insert caches@Caches{..} =-      if n < 0 then error "label overflow" else-      (caches {-         caches_nextId = n+1,-         caches_from = Map.insert ty (toAnyCache (Map.insert x n cache)) caches_from,-         caches_to = IntMap.insert (fromIntegral n) (toAny x) caches_to },-       Label n)-      where-        n = caches_nextId-        cache =-          fromAnyCache $-          Map.findWithDefault Map.empty ty caches_from---- | Recover the underlying value from a label.-find :: Label a -> a--- N.B. must force n before calling readIORef, otherwise a call of--- the form---   find (label x)--- doesn't work.-find (Label !n) = unsafeDupablePerformIO $ do-  Caches{..} <- readIORef cachesRef-  x <- return $! fromAny (IntMap.findWithDefault undefined (fromIntegral n) caches_to)-  return x
− src/Twee/PassiveQueue.hs 
@@ -1,183 +0,0 @@--- | A queue of passive critical pairs, using a memory-efficient representation.-{-# LANGUAGE TypeFamilies, RecordWildCards, FlexibleContexts, ScopedTypeVariables, StandaloneDeriving #-}-module Twee.PassiveQueue(-  Params(..),-  Queue,-  Passive(..),-  empty, insert, removeMin, mapMaybe) where--import qualified Data.Heap as Heap-import qualified Data.Vector.Unboxed as Vector-import Data.Int-import Data.List hiding (insert)-import qualified Data.Maybe-import Data.Ord-import Data.Proxy-import Twee.Utils---- | A datatype representing all the type parameters of the queue.-class (Eq (Id params), Integral (Id params), Ord (Score params), Vector.Unbox (PackedScore params), Vector.Unbox (PackedId params)) => Params params where-  -- | The score assigned to critical pairs. Smaller scores are better.-  type Score params-  -- | The type of ID numbers used to name rules.-  type Id params--  -- | A 'Score' packed for storage into a 'Vector.Vector'. Must be an instance of 'Vector.Unbox'.-  type PackedScore params-  -- | An 'Id' packed for storage into a 'Vector.Vector'. Must be an instance of 'Vector.Unbox'.-  type PackedId params--  -- | Pack a 'Score'.-  packScore :: proxy params -> Score params -> PackedScore params-  -- | Unpack a 'PackedScore'.-  unpackScore :: proxy params -> PackedScore params -> Score params-  -- | Pack an 'Id'.-  packId :: proxy params -> Id params -> PackedId params-  -- | Unpack a 'PackedId'.-  unpackId :: proxy params -> PackedId params -> Id params---- | A critical pair queue.-newtype Queue params =-  Queue (Heap.Heap (PassiveSet params))---- All passive CPs generated from one given rule.-data PassiveSet params =-  PassiveSet {-    passiveset_best  :: {-# UNPACK #-} !(Passive params),-    passiveset_rule  :: !(Id params),-    -- CPs where the rule is the left-hand rule-    passiveset_left  :: {-# UNPACK #-} !(Vector.Vector (PackedScore params, PackedId params, Int32)),-    -- CPs where the rule is the right-hand rule-    passiveset_right :: {-# UNPACK #-} !(Vector.Vector (PackedScore params, PackedId params, Int32)) }-instance Params params => Eq (PassiveSet params) where-  x == y = compare x y == EQ-instance Params params => Ord (PassiveSet params) where-  compare = comparing passiveset_best---- A smart-ish constructor.-{-# INLINEABLE mkPassiveSet #-}-mkPassiveSet ::-  Params params =>-  Proxy params ->-  Id params ->-  Vector.Vector (PackedScore params, PackedId params, Int32) ->-  Vector.Vector (PackedScore params, PackedId params, Int32) ->-  Maybe (PassiveSet params)-mkPassiveSet proxy rule left right-  | Vector.null left && Vector.null right = Nothing-  | not (Vector.null left) &&-    (Vector.null right || l <= r) =-    Just PassiveSet {-      passiveset_best  = l,-      passiveset_rule  = rule,-      passiveset_left  = Vector.tail left,-      passiveset_right = right }-    -- In this case we must have not (Vector.null right).-  | otherwise =-    Just PassiveSet {-      passiveset_best  = r,-      passiveset_rule  = rule,-      passiveset_left  = left,-      passiveset_right = Vector.tail right }-  where-    l = unpack proxy rule True (Vector.head left)-    r = unpack proxy rule False (Vector.head right)---- Unpack a triple into a Passive.-{-# INLINEABLE unpack #-}-unpack :: Params params => Proxy params -> Id params -> Bool -> (PackedScore params, PackedId params, Int32) -> Passive params-unpack proxy rule isLeft (score, id, pos) =-  Passive {-    passive_score = unpackScore proxy score,-    passive_rule1 = if isLeft then rule else rule',-    passive_rule2 = if isLeft then rule' else rule,-    passive_pos = fromIntegral pos }-  where-    rule' = unpackId proxy id---- Make a PassiveSet from a list of Passives.-{-# INLINEABLE makePassiveSet #-}-makePassiveSet :: forall params. Params params => Id params -> [Passive params] -> Maybe (PassiveSet params)-makePassiveSet _ [] = Nothing-makePassiveSet rule ps-  | and [passive_rule2 p == rule | p <- right] =-    mkPassiveSet proxy rule-      (Vector.fromList (map (pack True) (sort left)))-      (Vector.fromList (map (pack False) (sort right)))-  | otherwise = error "rule id does not occur in passive"-  where-    proxy :: Proxy params-    proxy = Proxy-    -    (left, right) = partition (\p -> passive_rule1 p == rule) ps-    pack isLeft Passive{..} =-      (packScore proxy passive_score,-       packId proxy (if isLeft then passive_rule2 else passive_rule1),-       fromIntegral passive_pos)---- Find and remove the best element from a PassiveSet.-{-# INLINEABLE unconsPassiveSet #-}-unconsPassiveSet :: forall params. Params params => PassiveSet params -> (Passive params, Maybe (PassiveSet params))-unconsPassiveSet PassiveSet{..} =-  (passiveset_best, mkPassiveSet (Proxy :: Proxy params) passiveset_rule passiveset_left passiveset_right)---- | A queued critical pair.-data Passive params =-  Passive {-    -- | The score of this critical pair.-    passive_score :: !(Score params),-    -- | The rule which does the outermost rewrite in this critical pair.-    passive_rule1 :: !(Id params),-    -- | The rule which does the innermost rewrite in this critical pair.-    passive_rule2 :: !(Id params),-    -- | The position of the overlap. See 'Twee.CP.overlap_pos'.-    passive_pos   :: {-# UNPACK #-} !Int }--instance Params params => Eq (Passive params) where-  x == y = compare x y == EQ--instance Params params => Ord (Passive params) where-  compare = comparing f-    where-      f Passive{..} =-        (passive_score,-         intMax (fromIntegral passive_rule1) (fromIntegral passive_rule2),-         intMin (fromIntegral passive_rule1) (fromIntegral passive_rule2),-         passive_pos)---- | The empty queue.-empty :: Queue params-empty = Queue Heap.empty---- | Add a set of 'Passive's to the queue.-{-# INLINEABLE insert #-}-insert :: Params params => Id params -> [Passive params] -> Queue params -> Queue params-insert rule passives (Queue q) =-  Queue $-  case makePassiveSet rule passives of-    Nothing -> q-    Just p -> Heap.insert p q---- | Remove the minimum 'Passive' from the queue.-{-# INLINEABLE removeMin #-}-removeMin :: Params params => Queue params -> Maybe (Passive params, Queue params)-removeMin (Queue q) = do-  (passiveset, q) <- Heap.removeMin q-  case unconsPassiveSet passiveset of-    (passive, Just passiveset') ->-      Just (passive, Queue (Heap.insert passiveset' q))-    (passive, Nothing) ->-      Just (passive, Queue q)---- | Map a function over all 'Passive's.-{-# INLINEABLE mapMaybe #-}-mapMaybe :: Params params => (Passive params -> Maybe (Passive params)) -> Queue params -> Queue params-mapMaybe f (Queue q) = Queue (Heap.mapMaybe g q)-  where-    g PassiveSet{..} =-      makePassiveSet passiveset_rule $ Data.Maybe.mapMaybe f $-        passiveset_best:-        map (unpack proxy passiveset_rule True) (Vector.toList passiveset_left) ++-        map (unpack proxy passiveset_rule False) (Vector.toList passiveset_right)-    proxy :: Proxy params-    proxy = Proxy
− src/Twee/Pretty.hs 
@@ -1,182 +0,0 @@--- | Pretty-printing of terms and assorted other values.--{-# LANGUAGE Rank2Types #-}-module Twee.Pretty(module Twee.Pretty, module Text.PrettyPrint.HughesPJClass, Pretty(..)) where--import Text.PrettyPrint.HughesPJClass hiding (empty)-import qualified Text.PrettyPrint.HughesPJClass as PP-import qualified Data.Map as Map-import Data.Map(Map)-import qualified Data.Set as Set-import Data.Set(Set)-import Data.Ratio-import Twee.Term---- * Miscellaneous 'Pretty' instances and utilities.---- | Print a value to the console.-prettyPrint :: Pretty a => a -> IO ()-prettyPrint x = putStrLn (prettyShow x)---- | The empty document. Used to avoid name clashes with 'Twee.Term.empty'.-pPrintEmpty :: Doc-pPrintEmpty = PP.empty--instance Pretty Doc where pPrint = id---- | Print a tuple of values.-pPrintTuple :: [Doc] -> Doc-pPrintTuple = parens . fsep . punctuate comma--instance Pretty a => Pretty (Set a) where-  pPrint = pPrintSet . map pPrint . Set.toList---- | Print a set of vlaues.-pPrintSet :: [Doc] -> Doc-pPrintSet = braces . fsep . punctuate comma--instance Pretty Var where-  pPrint (V n) =-    text $-      vars !! (n `mod` length vars):-      case n `div` length vars of-        0 -> ""-        m -> show (m+1)-    where-      vars = "XYZWVUTS"--instance (Pretty k, Pretty v) => Pretty (Map k v) where-  pPrint = pPrintSet . map binding . Map.toList-    where-      binding (x, v) = hang (pPrint x <+> text "=>") 2 (pPrint v)--instance (Eq a, Integral a, Pretty a) => Pretty (Ratio a) where-  pPrint a-    | denominator a == 1 = pPrint (numerator a)-    | otherwise = text "(" <+> pPrint (numerator a) <> text "/" <> pPrint (denominator a) <+> text ")"---- | Generate a list of candidate names for pretty-printing.-supply :: [String] -> [String]-supply names =-  names ++-  [ name ++ show i | i <- [2..], name <- names ]---- * Pretty-printing of terms.--instance Pretty f => Pretty (Fun f) where-  pPrintPrec l p = pPrintPrec l p . fun_value--instance PrettyTerm f => PrettyTerm (Fun f) where-  termStyle f = termStyle (fun_value f)--instance PrettyTerm f => Pretty (Term f) where-  pPrintPrec l p (Var x) = pPrintPrec l p x-  pPrintPrec l p (App f xs) =-    pPrintTerm (termStyle f) l p (pPrint f) (unpack xs)--instance PrettyTerm f => Pretty (TermList f) where-  pPrintPrec _ _ = pPrint . unpack--instance PrettyTerm f => Pretty (Subst f) where-  pPrint sub = text "{" <> fsep (punctuate (text ",") docs) <> text "}"-    where-      docs =-        [ hang (pPrint x <+> text "->") 2 (pPrint t)-        | (x, t) <- substToList sub ]---- | A class for customising the printing of function symbols.-class Pretty f => PrettyTerm f where-  -- | The style of the function symbol. Defaults to 'curried'.-  termStyle :: f -> TermStyle-  termStyle _ = curried---- | Defines how to print out a function symbol.-newtype TermStyle =-  TermStyle {-    -- | Renders a function application.-    -- Takes the following arguments in this order:-    -- Pretty-printing level, current precedence,-    -- pretty-printed function symbol and list of arguments to the function.-    pPrintTerm :: forall a. Pretty a => PrettyLevel -> Rational -> Doc -> [a] -> Doc }--invisible, curried, uncurried, prefix, postfix :: TermStyle---- | For operators like @$@ that should be printed as a blank space.-invisible =-  TermStyle $ \l p d ->-    let-      f [] = d-      f [t] = pPrintPrec l p t-      f (t:ts) =-        maybeParens (p > 10) $-          pPrint t <+>-            (hsep (map (pPrintPrec l 11) ts))-    in f---- | For functions that should be printed curried.-curried =-  TermStyle $ \l p d ->-    let-      f [] = d-      f xs =-        maybeParens (p > 10) $-          d <+>-            (hsep (map (pPrintPrec l 11) xs))-    in f---- | For functions that should be printed uncurried.-uncurried =-  TermStyle $ \l _ d ->-    let-      f [] = d-      f xs =-        d <> parens (hsep (punctuate comma (map (pPrintPrec l 0) xs)))-    in f---- | A helper function that deals with under- and oversaturated applications.-fixedArity :: Int -> TermStyle -> TermStyle-fixedArity arity style =-  TermStyle $ \l p d ->-    let-      f xs-        | length xs < arity = pPrintTerm curried l p (parens d) xs-        | length xs > arity =-            maybeParens (p > 10) $-              hsep (pPrintTerm style l 11 d ys:-                    map (pPrintPrec l 11) zs)-        | otherwise = pPrintTerm style l p d xs-        where-          (ys, zs) = splitAt arity xs-    in f---- | A helper function that drops a certain number of arguments.-implicitArguments :: Int -> TermStyle -> TermStyle-implicitArguments n (TermStyle pp) =-  TermStyle $ \l p d xs -> pp l p d (drop n xs)---- | For prefix operators.-prefix =-  fixedArity 1 $-  TermStyle $ \l _ d [x] ->-    d <> pPrintPrec l 11 x---- | For postfix operators.-postfix =-  fixedArity 1 $-  TermStyle $ \l _ d [x] ->-    pPrintPrec l 11 x <> d---- | For infix operators.-infixStyle :: Int -> TermStyle-infixStyle pOp =-  fixedArity 2 $-  TermStyle $ \l p d [x, y] ->-    maybeParens (p > fromIntegral pOp) $-      pPrintPrec l (fromIntegral pOp+1) x <+> d <+>-      pPrintPrec l (fromIntegral pOp+1) y---- | For tuples.-tupleStyle :: TermStyle-tupleStyle =-  TermStyle $ \l _ _ xs ->-    parens (hsep (punctuate comma (map (pPrintPrec l 0) xs)))
− src/Twee/Proof.hs 
@@ -1,723 +0,0 @@--- | Equational proofs which are checked for correctedness.-{-# LANGUAGE TypeFamilies, PatternGuards, RecordWildCards, ScopedTypeVariables #-}-module Twee.Proof(-  -- * Constructing proofs-  Proof, Derivation(..), Lemma(..), Axiom(..),-  certify, equation, derivation,-  -- ** Smart constructors for derivations-  lemma, axiom, symm, trans, cong, congPath,--  -- * Analysing proofs-  simplify, usedLemmas, usedAxioms, usedLemmasAndSubsts, usedAxiomsAndSubsts,--  -- * Pretty-printing proofs-  Config(..), defaultConfig, Presentation(..),-  ProvedGoal(..), provedGoal, checkProvedGoal,-  pPrintPresentation, present, describeEquation) where--import Twee.Base hiding (invisible)-import Twee.Equation-import Twee.Utils-import Control.Monad-import Data.Maybe-import Data.List-import Data.Ord-import qualified Data.Set as Set-import qualified Data.Map.Strict as Map--------------------------------------------------------------------------- Equational proofs. Only valid proofs can be constructed.--------------------------------------------------------------------------- | A checked proof. If you have a value of type @Proof f@,--- it should jolly well represent a valid proof!------ The only way to construct a @Proof f@ is by using 'certify'.-data Proof f =-  Proof {-    equation   :: !(Equation f),-    derivation :: !(Derivation f) }-  deriving (Eq, Show)---- | A derivation is an unchecked proof. It might be wrong!--- The way to check it is to call 'certify' to turn it into a 'Proof'.-data Derivation f =-    -- | Apply an existing rule (with proof!) to the root of a term-    UseLemma {-# UNPACK #-} !(Lemma f) !(Subst f)-    -- | Apply an axiom to the root of a term-  | UseAxiom {-# UNPACK #-} !(Axiom f) !(Subst f)-    -- | Reflexivity. @'Refl' t@ proves @t = t@.-  | Refl !(Term f)-    -- | Symmetry-  | Symm !(Derivation f)-    -- | Transivitity-  | Trans !(Derivation f) !(Derivation f)-    -- | Congruence.-    -- Parallel, i.e., takes a function symbol and one derivation for each-    -- argument of that function.-  | Cong {-# UNPACK #-} !(Fun f) ![Derivation f]-  deriving (Eq, Show)---- | A lemma, which includes a proof.-data Lemma f =-  Lemma {-    -- | The id number of the lemma.-    -- Has no semantic meaning; for convenience only.-    lemma_id :: {-# UNPACK #-} !Id,-    -- | A proof of the lemma.-    lemma_proof :: !(Proof f) }-  deriving Show----  | An axiom, which comes without proof.-data Axiom f =-  Axiom {-    -- | The number of the axiom.-    -- Has no semantic meaning; for convenience only.-    axiom_number :: {-# UNPACK #-} !Int,-    -- | A description of the axiom.-    -- Has no semantic meaning; for convenience only.-    axiom_name :: !String,-    -- | The equation which the axiom asserts.-    axiom_eqn :: !(Equation f) }-  deriving (Eq, Ord, Show)---- | Checks a 'Derivation' and, if it is correct, returns a--- certified 'Proof'.------ If the 'Derivation' is incorrect, throws an exception.---- This is the trusted core of the module.-{-# INLINEABLE certify #-}-certify :: PrettyTerm f => Derivation f -> Proof f-certify p =-  {-# SCC certify #-}-  case check p of-    Nothing -> error ("Invalid proof created!\n" ++ prettyShow p)-    Just eqn -> Proof eqn p-  where-    check (UseLemma Lemma{..} sub) =-      return (subst sub (equation lemma_proof))-    check (UseAxiom Axiom{..} sub) =-      return (subst sub axiom_eqn)-    check (Refl t) =-      return (t :=: t)-    check (Symm p) = do-      t :=: u <- check p-      return (u :=: t)-    check (Trans p q) = do-      t :=: u1 <- check p-      u2 :=: v <- check q-      guard (u1 == u2)-      return (t :=: v)-    check (Cong f ps) = do-      eqns <- mapM check ps-      return-        (build (app f (map eqn_lhs eqns)) :=:-         build (app f (map eqn_rhs eqns)))--------------------------------------------------------------------------- Everything below this point need not be trusted, since all proof--- construction goes through the "proof" function.--------------------------------------------------------------------------- Typeclass instances.-instance Eq (Lemma f) where-  x == y = compare x y == EQ-instance Ord (Lemma f) where-  compare =-    comparing (\x ->-      -- Don't look into lemma proofs when comparing derivations,-      -- to avoid exponential blowup-      (lemma_id x, equation (lemma_proof x)))--instance Symbolic (Derivation f) where-  type ConstantOf (Derivation f) = f-  termsDL (UseLemma _ sub) = termsDL sub-  termsDL (UseAxiom _ sub) = termsDL sub-  termsDL (Refl t) = termsDL t-  termsDL (Symm p) = termsDL p-  termsDL (Trans p q) = termsDL p `mplus` termsDL q-  termsDL (Cong _ ps) = termsDL ps--  subst_ sub (UseLemma lemma s) = UseLemma lemma (subst_ sub s)-  subst_ sub (UseAxiom axiom s) = UseAxiom axiom (subst_ sub s)-  subst_ sub (Refl t) = Refl (subst_ sub t)-  subst_ sub (Symm p) = symm (subst_ sub p)-  subst_ sub (Trans p q) = trans (subst_ sub p) (subst_ sub q)-  subst_ sub (Cong f ps) = cong f (subst_ sub ps)--instance Function f => Pretty (Proof f) where-  pPrint = pPrintLemma defaultConfig prettyShow-instance PrettyTerm f => Pretty (Derivation f) where-  pPrint (UseLemma lemma sub) =-    text "subst" <> pPrintTuple [pPrint lemma, pPrint sub]-  pPrint (UseAxiom axiom sub) =-    text "subst" <> pPrintTuple [pPrint axiom, pPrint sub]-  pPrint (Refl t) =-    text "refl" <> pPrintTuple [pPrint t]-  pPrint (Symm p) =-    text "symm" <> pPrintTuple [pPrint p]-  pPrint (Trans p q) =-    text "trans" <> pPrintTuple [pPrint p, pPrint q]-  pPrint (Cong f ps) =-    text "cong" <> pPrintTuple (pPrint f:map pPrint ps)--instance PrettyTerm f => Pretty (Axiom f) where-  pPrint Axiom{..} =-    text "axiom" <>-    pPrintTuple [pPrint axiom_number, text axiom_name, pPrint axiom_eqn]--instance PrettyTerm f => Pretty (Lemma f) where-  pPrint Lemma{..} =-    text "lemma" <>-    pPrintTuple [pPrint lemma_id, pPrint (equation lemma_proof)]---- | Simplify a derivation.------ After simplification, a derivation has the following properties:------   * 'Symm' is pushed down next to 'Lemma' and 'Axiom'---   * 'Refl' only occurs inside 'Cong' or at the top level---   * 'Trans' is right-associated and is pushed inside 'Cong' if possible-simplify :: Minimal f => (Lemma f -> Maybe (Derivation f)) -> Derivation f -> Derivation f-simplify lem p = simp p-  where-    simp p@(UseLemma lemma sub) =-      case lem lemma of-        Nothing -> p-        Just q ->-          let-            -- Get rid of any variables that are not bound by sub-            -- (e.g., ones which only occur internally in q)-            dead = usort (vars q) \\ substDomain sub-          in simp (subst sub (erase dead q))-    simp (Symm p) = symm (simp p)-    simp (Trans p q) = trans (simp p) (simp q)-    simp (Cong f ps) = cong f (map simp ps)-    simp p = p--lemma :: Lemma f -> Subst f -> Derivation f-lemma lem@Lemma{..} sub = UseLemma lem sub--axiom :: Axiom f -> Derivation f-axiom ax@Axiom{..} =-  UseAxiom ax $-    fromJust $-    listToSubst [(x, build (var x)) | x <- vars axiom_eqn]--symm :: Derivation f -> Derivation f-symm (Refl t) = Refl t-symm (Symm p) = p-symm (Trans p q) = trans (symm q) (symm p)-symm (Cong f ps) = cong f (map symm ps)-symm p = Symm p--trans :: Derivation f -> Derivation f -> Derivation f-trans Refl{} p = p-trans p Refl{} = p-trans (Trans p q) r =-  -- Right-associate uses of transitivity.-  -- p cannot be a Trans (if it was created with the smart-  -- constructors) but q could be.-  Trans p (trans q r)--- Collect adjacent uses of congruence.-trans (Cong f ps) (Cong g qs) | f == g =-  transCong f ps qs-trans (Cong f ps) (Trans (Cong g qs) r) | f == g =-  trans (transCong f ps qs) r-trans p q = Trans p q--transCong :: Fun f -> [Derivation f] -> [Derivation f] -> Derivation f-transCong f ps qs =-  cong f (zipWith trans ps qs)--cong :: Fun f -> [Derivation f] -> Derivation f-cong f ps =-  case sequence (map unRefl ps) of-    Nothing -> Cong f ps-    Just ts -> Refl (build (app f ts))-  where-    unRefl (Refl t) = Just t-    unRefl _ = Nothing---- | Find all lemmas which are used in a derivation.-usedLemmas :: Derivation f -> [Lemma f]-usedLemmas p = map fst (usedLemmasAndSubsts p)---- | Find all lemmas which are used in a derivation,--- together with the substitutions used.-usedLemmasAndSubsts :: Derivation f -> [(Lemma f, Subst f)]-usedLemmasAndSubsts p = lem p []-  where-    lem (UseLemma lemma sub) = ((lemma, sub):)-    lem (Symm p) = lem p-    lem (Trans p q) = lem p . lem q-    lem (Cong _ ps) = foldr (.) id (map lem ps)-    lem _ = id---- | Find all axioms which are used in a derivation.-usedAxioms :: Derivation f -> [Axiom f]-usedAxioms p = map fst (usedAxiomsAndSubsts p)---- | Find all axioms which are used in a derivation,--- together with the substitutions used.-usedAxiomsAndSubsts :: Derivation f -> [(Axiom f, Subst f)]-usedAxiomsAndSubsts p = ax p []-  where-    ax (UseAxiom axiom sub) = ((axiom, sub):)-    ax (Symm p) = ax p-    ax (Trans p q) = ax p . ax q-    ax (Cong _ ps) = foldr (.) id (map ax ps)-    ax _ = id---- | Applies a derivation at a particular path in a term.-congPath :: [Int] -> Term f -> Derivation f -> Derivation f-congPath [] _ p = p-congPath (n:ns) (App f t) p | n <= length ts =-  cong f $-    map Refl (take n ts) ++-    [congPath ns (ts !! n) p] ++-    map Refl (drop (n+1) ts)-  where-    ts = unpack t-congPath _ _ _ = error "bad path"--------------------------------------------------------------------------- Pretty-printing of proofs.--------------------------------------------------------------------------- | Options for proof presentation.-data Config =-  Config {-    -- | Never inline lemmas.-    cfg_all_lemmas :: !Bool,-    -- | Inline all lemmas.-    cfg_no_lemmas :: !Bool,-    -- | Print out explicit substitutions.-    cfg_show_instances :: !Bool }---- | The default configuration.-defaultConfig :: Config-defaultConfig =-  Config {-    cfg_all_lemmas = False,-    cfg_no_lemmas = False,-    cfg_show_instances = False }---- | A proof, with all axioms and lemmas explicitly listed.-data Presentation f =-  Presentation {-    -- | The used axioms.-    pres_axioms :: [Axiom f],-    -- | The used lemmas.-    pres_lemmas :: [Lemma f],-    -- | The goals proved.-    pres_goals  :: [ProvedGoal f] }-  deriving Show---- Note: only the pg_proof field should be trusted!--- The remaining fields are for information only.-data ProvedGoal f =-  ProvedGoal {-    pg_number  :: Int,-    pg_name    :: String,-    pg_proof   :: Proof f,--    -- Extra fields for existentially-quantified goals, giving the original goal-    -- and the existential witness. These fields are not verified. If you want-    -- to check them, use checkProvedGoal.-    ---    -- In general, subst pg_witness_hint pg_goal_hint == equation pg_proof.-    -- For non-existential goals, pg_goal_hint == equation pg_proof-    -- and pg_witness_hint is the empty substitution.-    pg_goal_hint    :: Equation f,-    pg_witness_hint :: Subst f }-  deriving Show---- | Construct a @ProvedGoal@.-provedGoal :: Int -> String -> Proof f -> ProvedGoal f-provedGoal number name proof =-  ProvedGoal {-    pg_number = number,-    pg_name = name,-    pg_proof = proof,-    pg_goal_hint = equation proof,-    pg_witness_hint = emptySubst }---- | Check that pg_goal/pg_witness match up with pg_proof.-checkProvedGoal :: Function f => ProvedGoal f -> ProvedGoal f-checkProvedGoal pg@ProvedGoal{..}-  | subst pg_witness_hint pg_goal_hint == equation pg_proof =-    pg-  | otherwise =-    error $ show $-      text "Invalid ProvedGoal!" $$-      text "Claims to prove" <+> pPrint pg_goal_hint $$-      text "with witness" <+> pPrint pg_witness_hint <> text "," $$-      text "but actually proves" <+> pPrint (equation pg_proof)--instance Function f => Pretty (Presentation f) where-  pPrint = pPrintPresentation defaultConfig---- | Simplify and present a proof.-present :: Function f => Config -> [ProvedGoal f] -> Presentation f-present config goals =-  -- First find all the used lemmas, then hand off to presentWithGoals-  presentWithGoals config goals-    (used Set.empty (concatMap (usedLemmas . derivation . pg_proof) goals))-  where-    used lems [] = Set.elems lems-    used lems (x:xs)-      | x `Set.member` lems = used lems xs-      | otherwise =-        used (Set.insert x lems)-          (usedLemmas (derivation (lemma_proof x)) ++ xs)--presentWithGoals ::-  Function f =>-  Config -> [ProvedGoal f] -> [Lemma f] -> Presentation f-presentWithGoals config@Config{..} goals lemmas-  -- We inline a lemma if one of the following holds:-  --   * It only has one step-  --   * It is subsumed by an earlier lemma-  --   * It is only used once-  --   * It has to do with $equals (for printing of the goal proof)-  --   * The option cfg_no_lemmas is true-  -- First we compute all inlinings, then apply simplify to remove them,-  -- then repeat if any lemma was inlined-  | Map.null inlinings =-    let-      axioms = usort $-        concatMap (usedAxioms . derivation . pg_proof) goals ++-        concatMap (usedAxioms . derivation . lemma_proof) lemmas-    in-      Presentation axioms-        [ lemma { lemma_proof = flattenProof lemma_proof }-        | lemma@Lemma{..} <- lemmas ]-        [ decodeGoal (goal { pg_proof = flattenProof pg_proof })-        | goal@ProvedGoal{..} <- goals ]--  | otherwise =-    let-      inline lemma = Map.lookup lemma inlinings--      goals' =-        [ decodeGoal (goal { pg_proof = certify $ simplify inline (derivation pg_proof) })-        | goal@ProvedGoal{..} <- goals ]-      lemmas' =-        [ Lemma n (certify $ simplify inline (derivation p))-        | lemma@(Lemma n p) <- lemmas, not (lemma `Map.member` inlinings) ]-    in-      presentWithGoals config goals' lemmas'--  where-    inlinings =-      Map.fromList-        [ (lemma, p)-        | lemma <- lemmas, Just p <- [tryInline lemma]]--    tryInline (Lemma n p)-      | shouldInline n p = Just (derivation p)-    tryInline (Lemma n p)-      -- Check for subsumption by an earlier lemma-      | Just (Lemma m q) <- Map.lookup (canonicalise (t :=: u)) equations, m < n =-        Just (subsume p (derivation q))-      | Just (Lemma m q) <- Map.lookup (canonicalise (u :=: t)) equations, m < n =-        Just (subsume p (Symm (derivation q)))-      where-        t :=: u = equation p-    tryInline _ = Nothing--    shouldInline n p =-      cfg_no_lemmas ||-      oneStep (derivation p) ||-      (not cfg_all_lemmas &&-       (isJust (decodeEquality (eqn_lhs (equation p))) ||-        isJust (decodeEquality (eqn_rhs (equation p))) ||-        Map.lookup n uses == Just 1))-  -    subsume p q =-      -- Rename q so its variables match p's-      subst sub q-      where-        t  :=: u  = equation p-        t' :=: u' = equation (certify q)-        Just sub  = matchList (buildList [t', u']) (buildList [t, u])--    -- Record which lemma proves each equation-    equations =-      Map.fromList-        [ (canonicalise (equation lemma_proof), lemma)-        | lemma@Lemma{..} <- lemmas]--    -- Count how many times each lemma is used-    uses =-      Map.fromListWith (+)-        [ (lemma_id, 1)-        | Lemma{..} <--            concatMap usedLemmas-              (map (derivation . pg_proof) goals ++-               map (derivation . lemma_proof) lemmas) ]--    -- Check if a proof only has one step.-    -- Trans only occurs at the top level by this point.-    oneStep Trans{} = False-    oneStep _ = True--invisible :: Function f => Equation f -> Bool-invisible (t :=: u) = show (pPrint t) == show (pPrint u)---- Pretty-print the proof of a single lemma.-pPrintLemma :: Function f => Config -> (Id -> String) -> Proof f -> Doc-pPrintLemma Config{..} lemmaName p =-  ppTerm (eqn_lhs (equation q)) $$ pp (derivation q)-  where-    q = flattenProof p--    pp (Trans p q) = pp p $$ pp q-    pp p | invisible (equation (certify p)) = pPrintEmpty-    pp p =-      (text "= { by" <+>-       ppStep-         (nub (map (show . ppLemma) (usedLemmasAndSubsts p)) ++-          nub (map (show . ppAxiom) (usedAxiomsAndSubsts p))) <+>-       text "}" $$-       ppTerm (eqn_rhs (equation (certify p))))--    ppTerm t = text "  " <> pPrint t--    ppStep [] = text "reflexivity" -- ??-    ppStep [x] = text x-    ppStep xs =-      hcat (punctuate (text ", ") (map text (init xs))) <+>-      text "and" <+>-      text (last xs)--    ppLemma (Lemma{..}, sub) =-      text "lemma" <+> text (lemmaName lemma_id) <> showSubst sub-    ppAxiom (Axiom{..}, sub) =-      text "axiom" <+> pPrint axiom_number <+> parens (text axiom_name) <> showSubst sub--    showSubst sub-      | cfg_show_instances && not (null (substToList sub)) =-        text " with " <>-        fsep (punctuate comma-          [ pPrint x <+> text "->" <+> pPrint t-          | (x, t) <- substToList sub ])-      | otherwise = pPrintEmpty---- Transform a proof so that each step uses exactly one axiom--- or lemma. The proof will have the following form afterwards:---   * Trans only occurs at the outermost level and is right-associated---   * Each Cong has exactly one non-Refl argument (no parallel rewriting)---   * Symm only occurs innermost, i.e., next to UseLemma or UseAxiom---   * Refl only occurs as an argument to Cong, or outermost if the---     whole proof is a single reflexivity step-flattenProof :: Function f => Proof f -> Proof f-flattenProof =-  certify . flat . simplify (const Nothing) . derivation-  where-    flat (Trans p q) = trans (flat p) (flat q)-    flat p@(Cong f ps) =-      foldr trans (reflAfter p)-        [ Cong f $-            map reflAfter (take i ps) ++-            [p] ++-            map reflBefore (drop (i+1) ps)-        | (i, q) <- zip [0..] qs,-          p <- steps q ]-      where-        qs = map flat ps-    flat p = p--    reflBefore p = Refl (eqn_lhs (equation (certify p)))-    reflAfter p  = Refl (eqn_rhs (equation (certify p)))--    steps Refl{} = []-    steps (Trans p q) = steps p ++ steps q-    steps p = [p]--    trans (Trans p q) r = trans p (trans q r)-    trans Refl{} p = p-    trans p Refl{} = p-    trans p q =-      case strip q of-        Nothing -> Trans p q-        Just q' -> trans p q'--    strip p-      | t == u = Just (Refl t)-      | otherwise = strip' t p-      where-        t :=: u = equation (certify p)-    strip' t (Trans _ q)-      | eqn_lhs (equation (certify q)) == t = Just q-      | otherwise = strip' t q-    strip' _ _ = Nothing---- Transform a derivation into a list of single steps.--- Each step has the following form:---   * Trans does not occur---   * Symm only occurs innermost, i.e., next to UseLemma or UseAxiom---   * Each Cong has exactly one non-Refl argument (no parallel rewriting)---   * Refl only occurs as an argument to Cong-derivSteps :: Function f => Derivation f -> [Derivation f]-derivSteps = steps . derivation . flattenProof . certify-  where-    steps Refl{} = []-    steps (Trans p q) = steps p ++ steps q-    steps p = [p]---- | Print a presented proof.-pPrintPresentation :: forall f. Function f => Config -> Presentation f -> Doc-pPrintPresentation config (Presentation axioms lemmas goals) =-  vcat $ intersperse (text "") $-    vcat [ describeEquation "Axiom" (show n) (Just name) eqn-         | Axiom n name eqn <- axioms,-           not (invisible eqn) ]:-    [ pp "Lemma" (num n) Nothing (equation p) emptySubst p-    | Lemma n p <- lemmas,-      not (invisible (equation p)) ] ++-    [ pp "Goal" (show num) (Just pg_name) pg_goal_hint pg_witness_hint pg_proof-    | (num, ProvedGoal{..}) <- zip [1..] goals ]-  where-    pp kind n mname eqn witness p =-      describeEquation kind n mname eqn $$-      ppWitness witness $$-      text "Proof:" $$-      pPrintLemma config num p--    num x = show (fromJust (Map.lookup x nums))-    nums = Map.fromList (zip (map lemma_id lemmas) [n+1 ..])-    n = maximum $ 0:map axiom_number axioms--    ppWitness sub-      | sub == emptySubst = pPrintEmpty-      | otherwise =-          vcat [-            text "The goal is true when:",-            nest 2 $ vcat-              [ pPrint x <+> text "=" <+> pPrint t-              | (x, t) <- substToList sub ],-            if minimal `elem` funs sub then-              text "where" <+> doubleQuotes (pPrint (minimal :: Fun f)) <+>-              text "stands for an arbitrary term of your choice."-            else pPrintEmpty,-            text ""]---- | Format an equation nicely.------ Used both here and in the main file.-describeEquation ::-  PrettyTerm f =>-  String -> String -> Maybe String -> Equation f -> Doc-describeEquation kind num mname eqn =-  text kind <+> text num <>-  (case mname of-     Nothing -> text ""-     Just name -> text (" (" ++ name ++ ")")) <>-  text ":" <+> pPrint eqn <> text "."--------------------------------------------------------------------------- Making proofs of existential goals more readable.--------------------------------------------------------------------------- The idea: the only axioms which mention $equals, $true and $false--- are:---   * $equals(x,x) = $true  (reflexivity)---   * $equals(t,u) = $false (conjecture)--- This implies that a proof $true = $false must have the following--- structure, if we expand out all lemmas:---   $true = $equals(s,s) = ... = $equals(t,u) = $false.------ The substitution in the last step $equals(t,u) = $false is in fact the--- witness to the existential.------ Furthermore, we can make it so that the inner "..." doesn't use the $equals--- axioms. If it does, one of the "..." steps results in either $true or $false,--- and we can chop off everything before the $true or after the $false.------ Once we have done that, every proof step in the "..." must be a congruence--- step of the shape---   $equals(t, u) = $equals(v, w).--- This is because there are no other axioms which mention $equals. Hence we can--- split the proof of $equals(s,s) = $equals(t,u) into separate proofs of s=t--- and s=u.------ What we have got out is:---   * the witness to the existential---   * a proof that both sides of the conjecture are equal--- and we can present that to the user.---- Decode $equals(t,u) into an equation t=u.-decodeEquality :: Function f => Term f -> Maybe (Equation f)-decodeEquality (App equals (Cons t (Cons u Empty)))-  | isEquals equals = Just (t :=: u)-decodeEquality _ = Nothing---- Tries to transform a proof of $true = $false into a proof of--- the original existentially-quantified formula.-decodeGoal :: Function f => ProvedGoal f -> ProvedGoal f-decodeGoal pg =-  case maybeDecodeGoal pg of-    Nothing -> pg-    Just (name, witness, goal, deriv) ->-      checkProvedGoal $-      pg {-        pg_name = name,-        pg_proof = certify deriv,-        pg_goal_hint = goal,-        pg_witness_hint = witness }--maybeDecodeGoal :: forall f. Function f =>-  ProvedGoal f -> Maybe (String, Subst f, Equation f, Derivation f)-maybeDecodeGoal ProvedGoal{..}-  -- N.B. presentWithGoals takes care of expanding any lemma which mentions-  -- $equals, and flattening the proof.-  | isFalseTerm u = extract (derivSteps deriv)-    -- Orient the equation so that $false is the RHS.-  | isFalseTerm t = extract (derivSteps (symm deriv))-  | otherwise = Nothing-  where-    isFalseTerm, isTrueTerm :: Term f -> Bool-    isFalseTerm (App false _) = isFalse false-    isFalseTerm _ = False-    isTrueTerm (App true _) = isTrue true-    isTrueTerm _ = False--    t :=: u = equation pg_proof-    deriv = derivation pg_proof--    -- Detect $true = $equals(t, t).-    decodeReflexivity :: Derivation f -> Maybe (Term f)-    decodeReflexivity (Symm (UseAxiom Axiom{..} sub)) = do-      guard (isTrueTerm (eqn_rhs axiom_eqn))-      (t :=: u) <- decodeEquality (eqn_lhs axiom_eqn)-      guard (t == u)-      return (subst sub t)-    decodeReflexivity _ = Nothing--    -- Detect $equals(t, u) = $false.-    decodeConjecture :: Derivation f -> Maybe (String, Equation f, Subst f)-    decodeConjecture (UseAxiom Axiom{..} sub) = do-      guard (isFalseTerm (eqn_rhs axiom_eqn))-      eqn <- decodeEquality (eqn_lhs axiom_eqn)-      return (axiom_name, eqn, sub)-    decodeConjecture _ = Nothing--    extract (p:ps) = do-      -- Start by finding $true = $equals(t,u).-      t <- decodeReflexivity p-      cont (Refl t) (Refl t) ps-    extract [] = Nothing--    cont p1 p2 (p:ps)-      | Just t <- decodeReflexivity p =-        cont (Refl t) (Refl t) ps-      | Just (name, eqn, sub) <- decodeConjecture p =-        -- If p1: s=t and p2: s=u-        -- then symm p1 `trans` p2: t=u.-        return (name, sub, eqn, symm p1 `trans` p2)-      | Cong eq [p1', p2'] <- p, isEquals eq =-        cont (p1 `trans` p1') (p2 `trans` p2') ps-    cont _ _ _ = Nothing
− src/Twee/Rule.hs 
@@ -1,488 +0,0 @@--- | Term rewriting.-{-# LANGUAGE TypeFamilies, FlexibleContexts, RecordWildCards, BangPatterns, OverloadedStrings, MultiParamTypeClasses, ScopedTypeVariables, GeneralizedNewtypeDeriving #-}-module Twee.Rule where--import Twee.Base-import Twee.Constraints-import qualified Twee.Index as Index-import Twee.Index(Index)-import Control.Monad-import Control.Monad.Trans.Class-import Control.Monad.Trans.State.Strict-import Data.Maybe-import Data.List-import Twee.Utils-import qualified Data.Set as Set-import Data.Set(Set)-import qualified Twee.Term as Term-import Data.Ord-import Twee.Equation-import qualified Twee.Proof as Proof-import Twee.Proof(Derivation, Lemma(..))-import Data.Tuple------------------------------------------------------------------------------------- * Rewrite rules.------------------------------------------------------------------------------------- | A rewrite rule.-data Rule f =-  Rule {-    -- | Information about whether and how the rule is oriented.-    orientation :: !(Orientation f),-    -- Invariant:-    -- For oriented rules: vars rhs `isSubsetOf` vars lhs-    -- For unoriented rules: vars lhs == vars rhs--    -- | The left-hand side of the rule.-    lhs :: {-# UNPACK #-} !(Term f),-    -- | The right-hand side of the rule.-    rhs :: {-# UNPACK #-} !(Term f) }-  deriving (Eq, Ord, Show)-type RuleOf a = Rule (ConstantOf a)---- | A rule's orientation.------ 'Oriented' and 'WeaklyOriented' rules are used only left-to-right.--- 'Permutative' and 'Unoriented' rules are used bidirectionally.-data Orientation f =-    -- | An oriented rule.-    Oriented-    -- | A weakly oriented rule.-    -- The first argument is the minimal constant, the second argument is a list-    -- of terms which are weakly oriented in the rule.-    -- -    -- A rule with orientation @'WeaklyOriented' k ts@ can be used unless-    -- all terms in @ts@ are equal to @k@.-  | WeaklyOriented {-# UNPACK #-} !(Fun f) [Term f]-    -- | A permutative rule.-    ---    -- A rule with orientation @'Permutative' ts@ can be used if-    -- @map fst ts@ is lexicographically greater than @map snd ts@.-  | Permutative [(Term f, Term f)]-    -- | An unoriented rule.-  | Unoriented-  deriving Show--instance Eq (Orientation f) where _ == _ = True-instance Ord (Orientation f) where compare _ _ = EQ---- | Is a rule oriented or weakly oriented?-oriented :: Orientation f -> Bool-oriented Oriented{} = True-oriented WeaklyOriented{} = True-oriented _ = False---- | Is a rule weakly oriented?-weaklyOriented :: Orientation f -> Bool-weaklyOriented WeaklyOriented{} = True-weaklyOriented _ = False--instance Symbolic (Rule f) where-  type ConstantOf (Rule f) = f-  termsDL (Rule or t u) = termsDL or `mplus` termsDL t `mplus` termsDL u-  subst_ sub (Rule or t u) = Rule (subst_ sub or) (subst_ sub t) (subst_ sub u)--instance f ~ g => Has (Rule f) (Term g) where-  the = lhs--instance Symbolic (Orientation f) where-  type ConstantOf (Orientation f) = f--  termsDL Oriented = mzero-  termsDL (WeaklyOriented _ ts) = termsDL ts-  termsDL (Permutative ts) = termsDL ts-  termsDL Unoriented = mzero--  subst_ _   Oriented = Oriented-  subst_ sub (WeaklyOriented min ts) = WeaklyOriented min (subst_ sub ts)-  subst_ sub (Permutative ts) = Permutative (subst_ sub ts)-  subst_ _   Unoriented = Unoriented--instance PrettyTerm f => Pretty (Rule f) where-  pPrint (Rule or l r) =-    pPrint l <+> text (showOrientation or) <+> pPrint r-    where-      showOrientation Oriented = "->"-      showOrientation WeaklyOriented{} = "~>"-      showOrientation Permutative{} = "<->"-      showOrientation Unoriented = "="---- | Turn a rule into an equation.-unorient :: Rule f -> Equation f-unorient (Rule _ l r) = l :=: r---- | Turn an equation t :=: u into a rule t -> u by computing the--- orientation info (e.g. oriented, permutative or unoriented).------ Crashes if t -> u is not a valid rule, for example if there is--- a variable in @u@ which is not in @t@. To prevent this happening,--- combine with 'Twee.CP.split'.-orient :: Function f => Equation f -> Rule f-orient (t :=: u) = Rule o t u-  where-    o | lessEq u t =-        case unify t u of-          Nothing -> Oriented-          Just sub-            | allSubst (\_ (Cons t Empty) -> isMinimal t) sub ->-              WeaklyOriented minimal (map (build . var . fst) (substToList sub))-            | otherwise -> Unoriented-      | lessEq t u = error "wrongly-oriented rule"-      | not (null (usort (vars u) \\ usort (vars t))) =-        error "unbound variables in rule"-      | Just ts <- evalStateT (makePermutative t u) [],-        permutativeOK t u ts =-        Permutative ts-      | otherwise = Unoriented--    permutativeOK _ _ [] = True-    permutativeOK t u ((Var x, Var y):xs) =-      lessIn model u t == Just Strict &&-      permutativeOK t' u' xs-      where-        model = modelFromOrder [Variable y, Variable x]-        sub x' = if x == x' then var y else var x'-        t' = subst sub t-        u' = subst sub u--    makePermutative t u = do-      msub <- gets listToSubst-      sub  <- lift msub-      aux (subst sub t) (subst sub u)-        where-          aux (Var x) (Var y)-            | x == y = return []-            | otherwise = do-              modify ((x, build $ var y):)-              return [(build $ var x, build $ var y)]--          aux (App f ts) (App g us)-            | f == g =-              fmap concat (zipWithM makePermutative (unpack ts) (unpack us))--          aux _ _ = mzero---- | Flip an unoriented rule so that it goes right-to-left.-backwards :: Rule f -> Rule f-backwards (Rule or t u) = Rule (back or) u t-  where-    back (Permutative xs) = Permutative (map swap xs)-    back Unoriented = Unoriented-    back _ = error "Can't turn oriented rule backwards"------------------------------------------------------------------------------------- * Extra-fast rewriting, without proof output or unorientable rules.------------------------------------------------------------------------------------- | Compute the normal form of a term wrt only oriented rules.-{-# INLINEABLE simplify #-}-simplify :: (Function f, Has a (Rule f)) => Index f a -> Term f -> Term f-simplify !idx !t = {-# SCC simplify #-} simplify1 idx t--{-# INLINEABLE simplify1 #-}-simplify1 :: (Function f, Has a (Rule f)) => Index f a -> Term f -> Term f-simplify1 idx t-  | t == u = t-  | otherwise = simplify idx u-  where-    u = build (simp (singleton t))--    simp Empty = mempty-    simp (Cons (Var x) t) = var x `mappend` simp t-    simp (Cons t u)-      | Just (rule, sub) <- simpleRewrite idx t =-        Term.subst sub (rhs rule) `mappend` simp u-    simp (Cons (App f ts) us) =-      app f (simp ts) `mappend` simp us---- | Check if a term can be simplified.-{-# INLINEABLE canSimplify #-}-canSimplify :: (Function f, Has a (Rule f)) => Index f a -> Term f -> Bool-canSimplify idx t = canSimplifyList idx (singleton t)--{-# INLINEABLE canSimplifyList #-}-canSimplifyList :: (Function f, Has a (Rule f)) => Index f a -> TermList f -> Bool-canSimplifyList idx t =-  {-# SCC canSimplifyList #-}-  any (isJust . simpleRewrite idx) (filter isApp (subtermsList t))---- | Find a simplification step that applies to a term.-{-# INLINEABLE simpleRewrite #-}-simpleRewrite :: (Function f, Has a (Rule f)) => Index f a -> Term f -> Maybe (Rule f, Subst f)-simpleRewrite idx t =-  -- Use instead of maybeToList to make fusion work-  foldr (\x _ -> Just x) Nothing $ do-    rule <- the <$> Index.approxMatches t idx-    guard (oriented (orientation rule))-    sub <- maybeToList (match (lhs rule) t)-    guard (reducesOriented rule sub)-    return (rule, sub)------------------------------------------------------------------------------------- * Rewriting, with proof output.------------------------------------------------------------------------------------- | A strategy gives a set of possible reductions for a term.-type Strategy f = Term f -> [Reduction f]---- | A multi-step rewrite proof @t ->* u@-data Reduction f =-    -- | Apply a single rewrite rule to the root of a term-    Step {-# UNPACK #-} !(Lemma f) !(Rule f) !(Subst f)-    -- | Reflexivity-  | Refl {-# UNPACK #-} !(Term f)-    -- | Transivitity-  | Trans !(Reduction f) !(Reduction f)-    -- | Congruence-  | Cong {-# UNPACK #-} !(Fun f) ![Reduction f]-  deriving Show--instance Symbolic (Reduction f) where-  type ConstantOf (Reduction f) = f-  termsDL (Step _ _ sub) = termsDL sub-  termsDL (Refl t) = termsDL t-  termsDL (Trans p q) = termsDL p `mplus` termsDL q-  termsDL (Cong _ ps) = termsDL ps--  subst_ sub (Step lemma rule s) = Step lemma rule (subst_ sub s)-  subst_ sub (Refl t) = Refl (subst_ sub t)-  subst_ sub (Trans p q) = Trans (subst_ sub p) (subst_ sub q)-  subst_ sub (Cong f ps) = Cong f (subst_ sub ps)--instance Function f => Pretty (Reduction f) where-  pPrint = pPrint . reductionProof---- | A smart constructor for Trans which simplifies Refl.-trans :: Reduction f -> Reduction f -> Reduction f-trans Refl{} p = p-trans p Refl{} = p--- Make right-associative to improve performance of 'result'-trans p (Trans q r) = Trans (Trans p q) r-trans p q = Trans p q---- | A smart constructor for Cong which simplifies Refl.-cong :: Fun f -> [Reduction f] -> Reduction f-cong f ps-  | all isRefl ps = Refl (result (reduce (Cong f ps)))-  | otherwise = Cong f ps-  where-    isRefl Refl{} = True-    isRefl _ = False---- | The list of all rewrite rules used in a rewrite proof.-steps :: Reduction f -> [Reduction f]-steps r = aux r []-  where-    aux step@Step{} = (step:)-    aux (Refl _) = id-    aux (Trans p q) = aux p . aux q-    aux (Cong _ ps) = foldr (.) id (map aux ps)---- | Turn a reduction into a proof.-reductionProof :: Reduction f -> Derivation f-reductionProof (Step lemma _ sub) =-  Proof.lemma lemma sub-reductionProof (Refl t) = Proof.Refl t-reductionProof (Trans p q) =-  Proof.trans (reductionProof p) (reductionProof q)-reductionProof (Cong f ps) = Proof.cong f (map reductionProof ps)---- | Construct a basic rewrite step.-{-# INLINE step #-}-step :: (Has a (Rule f), Has a (Lemma f)) => a -> Subst f -> Reduction f-step x sub = Step (the x) (the x) sub--------------------------------------------------------------------------- | A rewrite proof with the final term attached.--- Has an @Ord@ instance which compares the final term.-------------------------------------------------------------------------data Resulting f =-  Resulting {-    result :: {-# UNPACK #-} !(Term f),-    reduction :: !(Reduction f) }-  deriving Show--instance Eq (Resulting f) where x == y = compare x y == EQ-instance Ord (Resulting f) where compare = comparing result--instance Symbolic (Resulting f) where-  type ConstantOf (Resulting f) = f-  termsDL (Resulting t red) =-    termsDL t `mplus` termsDL red-  subst_ sub (Resulting t red) =-    Resulting (subst_ sub t) (subst_ sub red)--instance Function f => Pretty (Resulting f) where-  pPrint = pPrint . reduction---- | Construct a 'Resulting' from a 'Reduction'.-reduce :: Reduction f -> Resulting f-reduce p =-  Resulting (res p) p-  where-    res (Trans _ q) = res q-    res (Refl t) = t-    res p = {-# SCC res_emitRes #-} build (emitResult p)--    emitResult (Step _ r sub) = Term.subst sub (rhs r)-    emitResult (Refl t) = builder t-    emitResult (Trans _ q) = emitResult q-    emitResult (Cong f ps) = app f (map emitResult ps)------------------------------------------------------------------------------------- * Strategy combinators.------------------------------------------------------------------------------------- | Normalise a term wrt a particular strategy.-{-# INLINE normaliseWith #-}-normaliseWith :: Function f => (Term f -> Bool) -> Strategy f -> Term f -> Resulting f-normaliseWith ok strat t = {-# SCC normaliseWith #-} res-  where-    res = aux 0 (Refl t) t-    aux 1000 p _ =-      error $-        "Possibly nonterminating rewrite:\n" ++ prettyShow p-    aux n p t =-      case parallel strat t of-        (q:_) | u <- result (reduce q), ok u ->-          aux (n+1) (p `trans` q) u-        _ -> Resulting t p---- | Compute all normal forms of a set of terms wrt a particular strategy.-normalForms :: Function f => Strategy f -> [Resulting f] -> Set (Resulting f)-normalForms strat ps = snd (successorsAndNormalForms strat ps)---- | Compute all successors of a set of terms (a successor of a term @t@--- is a term @u@ such that @t ->* u@).-successors :: Function f => Strategy f -> [Resulting f] -> Set (Resulting f)-successors strat ps = Set.union qs rs-  where-    (qs, rs) = successorsAndNormalForms strat ps--{-# INLINEABLE successorsAndNormalForms #-}-successorsAndNormalForms :: Function f => Strategy f -> [Resulting f] ->-  (Set (Resulting f), Set (Resulting f))-successorsAndNormalForms strat ps =-  {-# SCC successorsAndNormalForms #-} go Set.empty Set.empty ps-  where-    go dead norm [] = (dead, norm)-    go dead norm (p:ps)-      | p `Set.member` dead = go dead norm ps-      | p `Set.member` norm = go dead norm ps-      | null qs = go dead (Set.insert p norm) ps-      | otherwise =-        go (Set.insert p dead) norm (qs ++ ps)-      where-        qs =-          [ reduce (reduction p `Trans` q)-          | q <- anywhere strat (result p) ]---- | Apply a strategy anywhere in a term.-anywhere :: Strategy f -> Strategy f-anywhere strat t = strat t ++ nested (anywhere strat) t---- | Apply a strategy to some child of the root function.-nested :: Strategy f -> Strategy f-nested _ Var{} = []-nested strat (App f ts) =-  cong f <$> inner [] ts-  where-    inner _ Empty = []-    inner before (Cons t u) =-      [ reverse before ++ [p] ++ map Refl (unpack u)-      | p <- strat t ] ++-      inner (Refl t:before) u---- | Apply a strategy in parallel in as many places as possible.--- Takes only the first rewrite of each strategy.-{-# INLINE parallel #-}-parallel :: PrettyTerm f => Strategy f -> Strategy f-parallel strat t =-  case par t of-    Refl{} -> []-    p -> [p]-  where-    par t | p:_ <- strat t = p-    par (App f ts) = cong f (inner [] ts)-    par t = Refl t--    inner before Empty = reverse before-    inner before (Cons t u) = inner (par t:before) u------------------------------------------------------------------------------------- * Basic strategies. These only apply at the root of the term.------------------------------------------------------------------------------------- | A strategy which rewrites using an index.-{-# INLINE rewrite #-}-rewrite :: (Function f, Has a (Rule f), Has a (Lemma f)) => (Rule f -> Subst f -> Bool) -> Index f a -> Strategy f-rewrite p rules t = do-  rule <- Index.approxMatches t rules-  tryRule p rule t---- | A strategy which applies one rule only.-{-# INLINEABLE tryRule #-}-tryRule :: (Function f, Has a (Rule f), Has a (Lemma f)) => (Rule f -> Subst f -> Bool) -> a -> Strategy f-tryRule p rule t = do-  sub <- maybeToList (match (lhs (the rule)) t)-  guard (p (the rule) sub)-  return (step rule sub)---- | Check if a rule can be applied, given an ordering <= on terms.-{-# INLINEABLE reducesWith #-}-reducesWith :: Function f => (Term f -> Term f -> Bool) -> Rule f -> Subst f -> Bool-reducesWith _ (Rule Oriented _ _) _ = True-reducesWith _ (Rule (WeaklyOriented min ts) _ _) sub =-  -- Be a bit careful here not to build new terms-  -- (reducesWith is used in simplify).-  -- This is the same as:-  --   any (not . isMinimal) (subst sub ts)-  any (not . isMinimal . expand) ts-  where-    expand t@(Var x) = fromMaybe t (Term.lookup x sub)-    expand t = t--    isMinimal (App f Empty) = f == min-    isMinimal _ = False-reducesWith p (Rule (Permutative ts) _ _) sub =-  aux ts-  where-    aux [] = False-    aux ((t, u):ts)-      | t' == u' = aux ts-      | otherwise = p u' t'-      where-        t' = subst sub t-        u' = subst sub u-reducesWith p (Rule Unoriented t u) sub =-  p u' t' && u' /= t'-  where-    t' = subst sub t-    u' = subst sub u---- | Check if a rule can be applied normally.-{-# INLINEABLE reduces #-}-reduces :: Function f => Rule f -> Subst f -> Bool-reduces rule sub = reducesWith lessEq rule sub---- | Check if a rule can be applied and is oriented.-{-# INLINEABLE reducesOriented #-}-reducesOriented :: Function f => Rule f -> Subst f -> Bool-reducesOriented rule sub =-  oriented (orientation rule) && reducesWith undefined rule sub---- | Check if a rule can be applied in a particular model.-{-# INLINEABLE reducesInModel #-}-reducesInModel :: Function f => Model f -> Rule f -> Subst f -> Bool-reducesInModel cond rule sub =-  reducesWith (\t u -> isJust (lessIn cond t u)) rule sub---- | Check if a rule can be applied to the Skolemised version of a term.-{-# INLINEABLE reducesSkolem #-}-reducesSkolem :: Function f => Rule f -> Subst f -> Bool-reducesSkolem rule sub =-  reducesWith (\t u -> lessEq (subst skolemise t) (subst skolemise u)) rule sub-  where-    skolemise = con . skolem
− src/Twee/Rule/Index.hs 
@@ -1,45 +0,0 @@-{-# LANGUAGE RecordWildCards, ScopedTypeVariables, FlexibleContexts #-}-module Twee.Rule.Index(-  RuleIndex(..),-  empty, insert, delete,-  approxMatches, matches, lookup) where--import Prelude hiding (lookup)-import Twee.Base hiding (lookup, empty)-import Twee.Rule-import Twee.Index hiding (insert, delete, empty)-import qualified Twee.Index as Index--data RuleIndex f a =-  RuleIndex {-    index_oriented :: !(Index f a),-    index_weak     :: !(Index f a),-    index_all      :: !(Index f a) }-  deriving Show--empty :: RuleIndex f a-empty = RuleIndex Index.empty Index.empty Index.empty--insert :: forall f a. Has a (Rule f) => Term f -> a -> RuleIndex f a -> RuleIndex f a-insert t x RuleIndex{..} =-  RuleIndex {-    index_oriented = insertWhen (oriented or) index_oriented,-    index_weak = insertWhen (weaklyOriented or) index_weak,-    index_all = insertWhen True index_all }-  where-    Rule or _ _ = the x :: Rule f--    insertWhen False idx = idx-    insertWhen True idx = Index.insert t x idx--delete :: forall f a. (Eq a, Has a (Rule f)) => Term f -> a -> RuleIndex f a -> RuleIndex f a-delete t x RuleIndex{..} =-  RuleIndex {-    index_oriented = deleteWhen (oriented or) index_oriented,-    index_weak = deleteWhen (weaklyOriented or) index_weak,-    index_all = deleteWhen True index_all }-  where-    Rule or _ _ = the x :: Rule f--    deleteWhen False idx = idx-    deleteWhen True idx = Index.delete t x idx
− src/Twee/Task.hs 
@@ -1,56 +0,0 @@--- | A module which can run housekeeping tasks every so often.-{-# LANGUAGE RecordWildCards #-}-module Twee.Task(Task, newTask, checkTask) where--import System.CPUTime-import Data.IORef-import Control.Monad.IO.Class--data TaskData m a =-  TaskData {-    -- When was the task created?-    task_start :: !Integer,-    -- When was the task last run?-    task_last :: !Integer,-    -- How long have we spent on this task so far?-    task_spent :: !Integer,-    -- How often should we run this task at most, in seconds?-    task_frequency :: !Double,-    -- What proportion of our time should we spend on the task?-    task_budget :: !Double,-    -- The task itself-    task_what :: m a }---- | A task which runs in the monad @m@ and produces a value of type @a@.-newtype Task m a = Task (IORef (TaskData m a))---- | Create a new task that should be run a certain proportion--- of the time. The first argument is how often in seconds the--- task should run, at most. The second argument is the maximum--- percentage of time that should be spent on the task.-newTask :: MonadIO m => Double -> Double -> m a -> m (Task m a)-newTask freq budget what = liftIO $ do-  now <- getCPUTime-  Task <$> newIORef (TaskData now now 0 freq budget what)---- | Run a task if it's time to run it.-checkTask :: MonadIO m => Task m a -> m (Maybe a)-checkTask (Task ref) = do-  task@TaskData{..} <- liftIO $ readIORef ref-  now <- liftIO getCPUTime-  if not (taskDue now task) then return Nothing else do-    res <- task_what-    after <- liftIO getCPUTime-    liftIO $ writeIORef ref task {-      task_last = after,-      task_spent = task_spent + (after-now) }-    return (Just res)---- Check if a task should be run now.-taskDue :: Integer -> TaskData m a -> Bool-taskDue now TaskData{..} =-  -- Don't run more than the frequency says.-  fromInteger (now - task_last) >= task_frequency * 10^12 &&-  -- Run if we spent less than task_budget proportion of the total time so far.-  -- Use > rather than >= so that tasks with zero budget never get run.-  fromInteger (now - task_start) * task_budget > fromInteger task_spent
− src/Twee/Term.hs 
@@ -1,646 +0,0 @@--- | Terms and substitutions.------ Terms in twee are represented as arrays rather than as an algebraic data--- type. This module defines pattern synonyms ('App', 'Var', 'Cons', 'Empty')--- which means that pattern matching on terms works just as normal.--- The pattern synonyms can not be used to create new terms; for that you--- have to use a builder interface ('Build').------ This module also provides:------   * pattern synonyms for iterating through a term one symbol at a time---     ('ConsSym');---   * substitutions ('Substitution', 'Subst', 'subst');---   * unification ('unify') and matching ('match');---   * miscellaneous useful functions on terms.-{-# LANGUAGE BangPatterns, PatternSynonyms, ViewPatterns, TypeFamilies, OverloadedStrings, ScopedTypeVariables #-}-module Twee.Term(-  -- * Terms-  Term, pattern Var, pattern App, isApp, isVar, singleton, len,-  -- * Termlists-  TermList, pattern Empty, pattern Cons, pattern ConsSym,-  pattern UnsafeCons, pattern UnsafeConsSym,-  empty, unpack, lenList,-  -- * Function symbols and variables-  Fun, fun, fun_id, fun_value, pattern F, Var(..), -  -- * Building terms-  Build(..),-  Builder,-  build, buildList,-  con, app, var,-  -- * Access to subterms-  children, properSubterms, subtermsList, subterms, occurs, isSubtermOf, isSubtermOfList, at,-  -- * Substitutions-  Substitution(..),-  subst,-  Subst(..),-  -- ** Constructing and querying substitutions-  emptySubst, listToSubst, substToList,-  lookup, lookupList,-  extend, extendList, unsafeExtendList,-  retract,-  -- ** Other operations on substitutions-  foldSubst, allSubst, substDomain,-  substSize,-  substCompose, substCompatible, substUnion, idempotent, idempotentOn,-  canonicalise,-  -- * Matching-  match, matchIn, matchList, matchListIn, isInstanceOf, isVariantOf,-  -- * Unification-  unify, unifyList,-  unifyTri, unifyListTri,-  TriangleSubst(..),-  close,-  -- * Positions in terms-  positionToPath, pathToPosition,-  replacePosition,-  replacePositionSub,-  -- * Miscellaneous functions-  bound, boundList, boundLists, mapFun, mapFunList, (<<)) where--import Prelude hiding (lookup)-import Twee.Term.Core hiding (F)-import Data.List hiding (lookup, find)-import Data.Maybe-import Data.Monoid-import Data.IntMap.Strict(IntMap)-import qualified Data.IntMap.Strict as IntMap------------------------------------------------------------------------------------- * A type class for builders------------------------------------------------------------------------------------- | Instances of 'Build' can be turned into terms using 'build' or 'buildList',--- and turned into term builders using 'builder'. Has instances for terms,--- termlists, builders, and Haskell lists.-class Build a where-  -- | The underlying type of function symbols.-  type BuildFun a-  -- | Convert a value into a 'Builder'.-  builder :: a -> Builder (BuildFun a)--instance Build (Builder f) where-  type BuildFun (Builder f) = f-  builder = id--instance Build (Term f) where-  type BuildFun (Term f) = f-  builder = emitTermList . singleton--instance Build (TermList f) where-  type BuildFun (TermList f) = f-  builder = emitTermList--instance Build a => Build [a] where-  type BuildFun [a] = BuildFun a-  {-# INLINE builder #-}-  builder = mconcat . map builder---- | Build a term. The given builder must produce exactly one term.-{-# INLINE build #-}-build :: Build a => a -> Term (BuildFun a)-build x =-  case buildList x of-    Cons t Empty -> t---- | Build a termlist.-{-# INLINE buildList #-}-buildList :: Build a => a -> TermList (BuildFun a)-buildList x = {-# SCC buildList #-} buildTermList (builder x)---- | Build a constant (a function with no arguments).-{-# INLINE con #-}-con :: Fun f -> Builder f-con x = emitApp x mempty---- | Build a function application.-{-# INLINE app #-}-app :: Build a => Fun (BuildFun a) -> a -> Builder (BuildFun a)-app f ts = emitApp f (builder ts)---- | Build a variable.-var :: Var -> Builder f-var = emitVar------------------------------------------------------------------------------------- Functions for substitutions.-----------------------------------------------------------------------------------{-# INLINE substToList' #-}-substToList' :: Subst f -> [(Var, TermList f)]-substToList' (Subst sub) = [(V x, t) | (x, t) <- IntMap.toList sub]---- | Convert a substitution to a list of bindings.-{-# INLINE substToList #-}-substToList :: Subst f -> [(Var, Term f)]-substToList sub =-  [(x, t) | (x, Cons t Empty) <- substToList' sub]---- | Fold a function over a substitution.-{-# INLINE foldSubst #-}-foldSubst :: (Var -> TermList f -> b -> b) -> b -> Subst f -> b-foldSubst op e !sub = foldr (uncurry op) e (substToList' sub)---- | Check if all bindings of a substitution satisfy a given property.-{-# INLINE allSubst #-}-allSubst :: (Var -> TermList f -> Bool) -> Subst f -> Bool-allSubst p = foldSubst (\x t y -> p x t && y) True---- | Compute the set of variables bound by a substitution.-{-# INLINE substDomain #-}-substDomain :: Subst f -> [Var]-substDomain (Subst sub) = map V (IntMap.keys sub)------------------------------------------------------------------------------------- Substitution.------------------------------------------------------------------------------------- | A class for values which act as substitutions.------ Instances include 'Subst' as well as functions from variables to terms.-class Substitution s where-  -- | The underlying type of function symbols.-  type SubstFun s--  -- | Apply the substitution to a variable.-  evalSubst :: s -> Var -> Builder (SubstFun s)--  -- | Apply the substitution to a termlist.-  {-# INLINE substList #-}-  substList :: s -> TermList (SubstFun s) -> Builder (SubstFun s)-  substList sub ts = aux ts-    where-      aux Empty = mempty-      aux (Cons (Var x) ts) = evalSubst sub x <> aux ts-      aux (Cons (App f ts) us) = app f (aux ts) <> aux us--instance (Build a, v ~ Var) => Substitution (v -> a) where-  type SubstFun (v -> a) = BuildFun a--  {-# INLINE evalSubst #-}-  evalSubst sub x = builder (sub x)--instance Substitution (Subst f) where-  type SubstFun (Subst f) = f--  {-# INLINE evalSubst #-}-  evalSubst sub x =-    case lookupList x sub of-      Nothing -> var x-      Just ts -> builder ts---- | Apply a substitution to a term.-{-# INLINE subst #-}-subst :: Substitution s => s -> Term (SubstFun s) -> Builder (SubstFun s)-subst sub t = substList sub (singleton t)---- | A substitution which maps variables to terms of type @'Term' f@.-newtype Subst f =-  Subst {-    unSubst :: IntMap (TermList f) }-  deriving Eq---- | Return the highest-number variable in a substitution plus 1.-{-# INLINE substSize #-}-substSize :: Subst f -> Int-substSize (Subst sub)-  | IntMap.null sub = 0-  | otherwise = fst (IntMap.findMax sub) + 1---- | Look up a variable in a substitution, returning a termlist.-{-# INLINE lookupList #-}-lookupList :: Var -> Subst f -> Maybe (TermList f)-lookupList x (Subst sub) = IntMap.lookup (var_id x) sub---- | Add a new binding to a substitution, giving a termlist.-{-# INLINE extendList #-}-extendList :: Var -> TermList f -> Subst f -> Maybe (Subst f)-extendList x !t (Subst sub) =-  case IntMap.lookup (var_id x) sub of-    Nothing -> Just $! Subst (IntMap.insert (var_id x) t sub)-    Just u-      | t == u    -> Just (Subst sub)-      | otherwise -> Nothing---- | Remove a binding from a substitution.-{-# INLINE retract #-}-retract :: Var -> Subst f -> Subst f-retract x (Subst sub) = Subst (IntMap.delete (var_id x) sub)---- | Add a new binding to a substitution.--- Overwrites any existing binding.-{-# INLINE unsafeExtendList #-}-unsafeExtendList :: Var -> TermList f -> Subst f -> Subst f-unsafeExtendList x !t (Subst sub) = Subst (IntMap.insert (var_id x) t sub)---- | Compose two substitutions.-substCompose :: Substitution s => Subst (SubstFun s) -> s -> Subst (SubstFun s)-substCompose (Subst !sub1) !sub2 =-  Subst (IntMap.map (buildList . substList sub2) sub1)---- | Check if two substitutions are compatible (they do not send the same--- variable to different terms).-substCompatible :: Subst f -> Subst f -> Bool-substCompatible (Subst !sub1) (Subst !sub2) =-  IntMap.null (IntMap.mergeWithKey f g h sub1 sub2)-  where-    f _ t u-      | t == u = Nothing-      | otherwise = Just t-    g _ = IntMap.empty-    h _ = IntMap.empty---- | Take the union of two substitutions.--- The substitutions must be compatible, which is not checked.-substUnion :: Subst f -> Subst f -> Subst f-substUnion (Subst !sub1) (Subst !sub2) =-  Subst (IntMap.union sub1 sub2)---- | Check if a substitution is idempotent (applying it twice has the same--- effect as applying it once).-{-# INLINE idempotent #-}-idempotent :: Subst f -> Bool-idempotent !sub = allSubst (\_ t -> sub `idempotentOn` t) sub---- | Check if a substitution has no effect on a given term.-{-# INLINE idempotentOn #-}-idempotentOn :: Subst f -> TermList f -> Bool-idempotentOn !sub = aux-  where-    aux Empty = True-    aux (ConsSym App{} t) = aux t-    aux (Cons (Var x) t) = isNothing (lookupList x sub) && aux t---- | Iterate a triangle substitution to make it idempotent.-close :: TriangleSubst f -> Subst f-close (Triangle sub)-  | idempotent sub = sub-  | otherwise      = close (Triangle (substCompose sub sub))---- | Return a substitution which renames the variables of a list of terms to put--- them in a canonical order.-canonicalise :: [TermList f] -> Subst f-canonicalise [] = emptySubst-canonicalise (t:ts) = loop emptySubst vars t ts-  where-    (V m, V n) = boundLists (t:ts)-    vars =-      buildTermList $-        -- Produces two variables when the term is ground-        -- (n = minBound, m = maxBound), which is OK.-        mconcat [emitVar (V x) | x <- [0..n-m+1]]--    loop !_ !_ !_ !_ | False = undefined-    loop sub _ Empty [] = sub-    loop sub Empty _ _ = sub-    loop sub vs Empty (t:ts) = loop sub vs t ts-    loop sub vs (ConsSym App{} t) ts = loop sub vs t ts-    loop sub vs0@(Cons v vs) (Cons (Var x) t) ts =-      case extend x v sub of-        Just sub -> loop sub vs  t ts-        Nothing  -> loop sub vs0 t ts---- | The empty substitution.-{-# NOINLINE emptySubst #-}-emptySubst = Subst IntMap.empty---- | Construct a substitution from a list.--- Returns @Nothing@ if a variable is bound to several different terms.-listToSubst :: [(Var, Term f)] -> Maybe (Subst f)-listToSubst sub = matchList pat t-  where-    pat = buildList (map (var . fst) sub)-    t   = buildList (map snd sub)------------------------------------------------------------------------------------- Matching.------------------------------------------------------------------------------------- | @'match' pat t@ matches the term @t@ against the pattern @pat@.-{-# INLINE match #-}-match :: Term f -> Term f -> Maybe (Subst f)-match pat t = matchList (singleton pat) (singleton t)---- | A variant of 'match' which extends an existing substitution.-{-# INLINE matchIn #-}-matchIn :: Subst f -> Term f -> Term f -> Maybe (Subst f)-matchIn sub pat t = matchListIn sub (singleton pat) (singleton t)---- | A variant of 'match' which works on termlists.-{-# INLINE matchList #-}-matchList :: TermList f -> TermList f -> Maybe (Subst f)-matchList pat t = matchListIn emptySubst pat t---- | A variant of 'match' which works on termlists--- and extends an existing substitution.-matchListIn :: Subst f -> TermList f -> TermList f -> Maybe (Subst f)-matchListIn !sub !pat !t-  | lenList t < lenList pat = Nothing-  | otherwise =-    let loop !_ !_ !_ | False = undefined-        loop sub Empty Empty = Just sub-        loop sub (ConsSym (App f _) pat) (ConsSym (App g _) t)-          | f == g = loop sub pat t-        loop sub (Cons (Var x) pat) (Cons t u) = do-          sub <- extend x t sub-          loop sub pat u-        loop _ _ _ = Nothing-    in {-# SCC match #-} loop sub pat t------------------------------------------------------------------------------------- Unification.------------------------------------------------------------------------------------- | A triangle substitution is one in which variables can be defined in terms--- of each other, though not in a circular way.------ The main use of triangle substitutions is in unification; 'unifyTri' returns--- one. A triangle substitution can be converted to an ordinary substitution--- with 'close', or used directly using its 'Substitution' instance.-newtype TriangleSubst f = Triangle { unTriangle :: Subst f }-  deriving Show--instance Substitution (TriangleSubst f) where-  type SubstFun (TriangleSubst f) = f--  {-# INLINE evalSubst #-}-  evalSubst (Triangle sub) x =-    case lookupList x sub of-      Nothing  -> var x-      Just ts  -> substList (Triangle sub) ts--  -- Redefine substList to get better inlining behaviour-  {-# INLINE substList #-}-  substList (Triangle sub) ts = aux ts-    where-      aux Empty = mempty-      aux (Cons (Var x) ts) = auxVar x <> aux ts-      aux (Cons (App f ts) us) = app f (aux ts) <> aux us--      auxVar x =-        case lookupList x sub of-          Nothing -> var x-          Just ts -> aux ts---- | Unify two terms.-unify :: Term f -> Term f -> Maybe (Subst f)-unify t u = unifyList (singleton t) (singleton u)---- | Unify two termlists.-unifyList :: TermList f -> TermList f -> Maybe (Subst f)-unifyList t u = do-  sub <- unifyListTri t u-  -- Not strict so that isJust (unify t u) doesn't force the substitution-  return (close sub)---- | Unify two terms, returning a triangle substitution.--- This is slightly faster than 'unify'.-unifyTri :: Term f -> Term f -> Maybe (TriangleSubst f)-unifyTri t u = unifyListTri (singleton t) (singleton u)---- | Unify two termlists, returning a triangle substitution.--- This is slightly faster than 'unify'.-unifyListTri :: TermList f -> TermList f -> Maybe (TriangleSubst f)-unifyListTri !t !u = fmap Triangle ({-# SCC unify #-} loop emptySubst t u)-  where-    loop !_ !_ !_ | False = undefined-    loop sub Empty Empty = Just sub-    loop sub (ConsSym (App f _) t) (ConsSym (App g _) u)-      | f == g = loop sub t u-    loop sub (Cons (Var x) t) (Cons u v) = do-      sub <- var sub x u-      loop sub t v-    loop sub (Cons t u) (Cons (Var x) v) = do-      sub <- var sub x t-      loop sub u v-    loop _ _ _ = Nothing--    var sub x t =-      case lookupList x sub of-        Just u -> loop sub u (singleton t)-        Nothing -> var1 sub x t--    var1 sub x t@(Var y)-      | x == y = return sub-      | otherwise =-        case lookup y sub of-          Just t  -> var1 sub x t-          Nothing -> extend x t sub--    var1 sub x t = do-      occurs sub x (singleton t)-      extend x t sub--    occurs !_ !_ Empty = Just ()-    occurs sub x (ConsSym App{} t) = occurs sub x t-    occurs sub x (ConsSym (Var y) t)-      | x == y = Nothing-      | otherwise = do-          occurs sub x t-          case lookupList y sub of-            Nothing -> Just ()-            Just u  -> occurs sub x u------------------------------------------------------------------------------------- Miscellaneous stuff.------------------------------------------------------------------------------------- | The empty termlist.-{-# NOINLINE empty #-}-empty :: forall f. TermList f-empty = buildList (mempty :: Builder f)---- | Get the children (direct subterms) of a term.-children :: Term f -> TermList f-children t =-  case singleton t of-    UnsafeConsSym _ ts -> ts---- | Convert a termlist into an ordinary list of terms.-unpack :: TermList f -> [Term f]-unpack t = unfoldr op t-  where-    op Empty = Nothing-    op (Cons t ts) = Just (t, ts)--instance Show (Term f) where-  show (Var x) = show x-  show (App f Empty) = show f-  show (App f ts) = show f ++ "(" ++ intercalate "," (map show (unpack ts)) ++ ")"--instance Show (TermList f) where-  show = show . unpack--instance Show (Subst f) where-  show subst =-    show-      [ (i, t)-      | i <- [0..substSize subst-1],-        Just t <- [lookup (V i) subst] ]---- | Look up a variable in a substitution.-{-# INLINE lookup #-}-lookup :: Var -> Subst f -> Maybe (Term f)-lookup x s = do-  Cons t Empty <- lookupList x s-  return t---- | Add a new binding to a substitution.-{-# INLINE extend #-}-extend :: Var -> Term f -> Subst f -> Maybe (Subst f)-extend x t sub = extendList x (singleton t) sub---- | Find the length of a term.-{-# INLINE len #-}-len :: Term f -> Int-len = lenList . singleton---- | Return the lowest- and highest-numbered variables in a term.-{-# INLINE bound #-}-bound :: Term f -> (Var, Var)-bound t = boundList (singleton t)---- | Return the lowest- and highest-numbered variables in a termlist.-{-# INLINE boundList #-}-boundList :: TermList f -> (Var, Var)-boundList t = boundListFrom (V maxBound) (V minBound) t--boundListFrom :: Var -> Var -> TermList f -> (Var, Var)-boundListFrom !m !n Empty = (m, n)-boundListFrom m n (ConsSym App{} t) = boundListFrom m n t-boundListFrom m n (ConsSym (Var x) t) =-  boundListFrom (m `min` x) (n `max` x) t---- | Return the lowest- and highest-numbered variables in a list of termlists.-boundLists :: [TermList f] -> (Var, Var)-boundLists t = boundListsFrom (V maxBound) (V minBound) t--boundListsFrom :: Var -> Var -> [TermList f] -> (Var, Var)-boundListsFrom !m !n [] = (m, n)-boundListsFrom m n (t:ts) =-  let-    (m', n') = boundListFrom m n t-  in-    boundListsFrom m' n' ts---- | Check if a variable occurs in a term.-{-# INLINE occurs #-}-occurs :: Var -> Term f -> Bool-occurs x t = occursList x (singleton t)---- | Find all subterms of a termlist.-{-# INLINE subtermsList #-}-subtermsList :: TermList f -> [Term f]-subtermsList t = unfoldr op t-  where-    op Empty = Nothing-    op (ConsSym t u) = Just (t, u)---- | Find all subterms of a term.-{-# INLINE subterms #-}-subterms :: Term f -> [Term f]-subterms = subtermsList . singleton---- | Find all proper subterms of a term.-{-# INLINE properSubterms #-}-properSubterms :: Term f -> [Term f]-properSubterms = subtermsList . children---- | Check if a term is a function application.-isApp :: Term f -> Bool-isApp App{} = True-isApp _     = False---- | Check if a term is a variable-isVar :: Term f -> Bool-isVar Var{} = True-isVar _     = False---- | @t \`'isInstanceOf'\` pat@ checks if @t@ is an instance of @pat@.-isInstanceOf :: Term f -> Term f -> Bool-t `isInstanceOf` pat = isJust (match pat t)---- | Check if two terms are renamings of one another.-isVariantOf :: Term f -> Term f -> Bool-t `isVariantOf` u = t `isInstanceOf` u && u `isInstanceOf` t---- | Is a term a subterm of another one?-isSubtermOf :: Term f -> Term f -> Bool-t `isSubtermOf` u = t `isSubtermOfList` singleton u---- | Map a function over the function symbols in a term.-mapFun :: (Fun f -> Fun g) -> Term f -> Builder g-mapFun f = mapFunList f . singleton---- | Map a function over the function symbols in a termlist.-mapFunList :: (Fun f -> Fun g) -> TermList f -> Builder g-mapFunList f ts = aux ts-  where-    aux Empty = mempty-    aux (Cons (Var x) ts) = var x `mappend` aux ts-    aux (Cons (App ff ts) us) = app (f ff) (aux ts) `mappend` aux us---- | Replace the term at a given position in a term with a different term.-{-# INLINE replacePosition #-}-replacePosition :: (Build a, BuildFun a ~ f) => Int -> a -> TermList f -> Builder f-replacePosition n !x = aux n-  where-    aux !_ !_ | False = undefined-    aux _ Empty = mempty-    aux 0 (Cons _ t) = builder x `mappend` builder t-    aux n (Cons (Var x) t) = var x `mappend` aux (n-1) t-    aux n (Cons t@(App f ts) u)-      | n < len t =-        app f (aux (n-1) ts) `mappend` builder u-      | otherwise =-        builder t `mappend` aux (n-len t) u---- | Replace the term at a given position in a term with a different term, while--- simultaneously applying a substitution. Useful for building critical pairs.-{-# INLINE replacePositionSub #-}-replacePositionSub :: (Substitution sub, SubstFun sub ~ f) => sub -> Int -> TermList f -> TermList f -> Builder f-replacePositionSub sub n !x = aux n-  where-    aux !_ !_ | False = undefined-    aux _ Empty = mempty-    aux n (Cons t u)-      | n < len t = inside n t `mappend` outside u-      | otherwise = outside (singleton t) `mappend` aux (n-len t) u--    inside 0 _ = outside x-    inside n (App f ts) = app f (aux (n-1) ts)-    inside _ _ = undefined -- implies n >= len t--    outside t = substList sub t---- | Convert a position in a term, expressed as a single number, into a path.-positionToPath :: Term f -> Int -> [Int]-positionToPath t n = term t n-  where-    term _ 0 = []-    term t n = list 0 (children t) (n-1)--    list _ Empty _ = error "bad position"-    list k (Cons t u) n-      | n < len t = k:term t n-      | otherwise = list (k+1) u (n-len t)---- | Convert a path in a term into a position.-pathToPosition :: Term f -> [Int] -> Int-pathToPosition t ns = term 0 t ns-  where-    term k _ [] = k-    term k t (n:ns) = list (k+1) (children t) n ns--    list _ Empty _ _ = error "bad path"-    list k (Cons t _) 0 ns = term k t ns-    list k (Cons t u) n ns =-      list (k+len t) u (n-1) ns---- | A pattern which extracts the 'fun_value' from a 'Fun'.-pattern F :: f -> Fun f-pattern F x <- (fun_value -> x)---- | Compare the 'fun_value's of two 'Fun's.-(<<) :: Ord f => Fun f -> Fun f -> Bool-f << g = fun_value f < fun_value g
− src/Twee/Term/Core.hs 
@@ -1,422 +0,0 @@--- Terms and substitutions, implemented using flatterms.--- This module contains all the low-level icky bits--- and provides primitives for building higher-level stuff.-{-# LANGUAGE CPP, PatternSynonyms, ViewPatterns,-    MagicHash, UnboxedTuples, BangPatterns,-    RankNTypes, RecordWildCards, GeneralizedNewtypeDeriving #-}-module Twee.Term.Core where--import Data.Primitive(sizeOf)-#ifdef BOUNDS_CHECKS-import Data.Primitive.ByteArray.Checked-#else-import Data.Primitive.ByteArray-#endif-import Control.Monad.ST.Strict-import Data.Bits-import Data.Int-import GHC.Int(Int(..))-import GHC.Prim-import GHC.ST hiding (liftST)-import Data.Ord-import Twee.Label-import Data.Typeable------------------------------------------------------------------------------------- Symbols. A symbol is a single function or variable in a flatterm.-----------------------------------------------------------------------------------data Symbol =-  Symbol {-    -- Is it a function?-    isFun :: Bool,-    -- What is its number?-    index :: Int,-    -- What is the size of the term rooted at this symbol?-    size  :: Int }--instance Show Symbol where-  show Symbol{..}-    | isFun = show (F index) ++ "=" ++ show size-    | otherwise = show (V index)---- Convert symbols to/from Int64 for storage in flatterms.--- The encoding:---   * bits 0-30: size---   * bit  31: 0 (variable) or 1 (function)---   * bits 32-63: index-{-# INLINE toSymbol #-}-toSymbol :: Int64 -> Symbol-toSymbol n =-  Symbol (testBit n 31)-    (fromIntegral (n `unsafeShiftR` 32))-    (fromIntegral (n .&. 0x7fffffff))--{-# INLINE fromSymbol #-}-fromSymbol :: Symbol -> Int64-fromSymbol Symbol{..} =-  fromIntegral size +-  fromIntegral index `unsafeShiftL` 32 +-  fromIntegral (fromEnum isFun) `unsafeShiftL` 31------------------------------------------------------------------------------------- Flatterms, or rather lists of terms.------------------------------------------------------------------------------------- | @'TermList' f@ is a list of terms whose function symbols have type @f@.--- It is either a 'Cons' or an 'Empty'. You can turn it into a @['Term' f]@--- with 'Twee.Term.unpack'.---- A TermList is a slice of an unboxed array of symbols.-data TermList f =-  TermList {-    low   :: {-# UNPACK #-} !Int,-    high  :: {-# UNPACK #-} !Int,-    array :: {-# UNPACK #-} !ByteArray }---- | Index into a termlist.-at :: Int -> TermList f -> Term f-at n (TermList lo hi arr)-  | n < 0 || lo+n >= hi = error "term index out of bounds"-  | otherwise =-    case TermList (lo+n) hi arr of-      UnsafeCons t _ -> t--{-# INLINE lenList #-}--- | The length of (number of symbols in) a termlist.-lenList :: TermList f -> Int-lenList (TermList low high _) = high - low---- | @'Term' f@ is a term whose function symbols have type @f@.--- It is either a 'Var' or an 'App'.---- A term is a special case of a termlist.--- We store it as the termlist together with the root symbol.-data Term f =-  Term {-    root     :: {-# UNPACK #-} !Int64,-    termlist :: {-# UNPACK #-} !(TermList f) }--instance Eq (Term f) where-  x == y = termlist x == termlist y--instance Ord (Term f) where-  compare = comparing termlist---- Pattern synonyms for termlists:--- * Empty :: TermList f---   Empty is the empty termlist.--- * Cons t ts :: Term f -> TermList f -> TermList f---   Cons t ts is the termlist t:ts.--- * ConsSym t ts :: Term f -> TermList f -> TermList f---   ConsSym t ts is like Cons t ts but ts also includes t's children---   (operationally, ts seeks one term to the right in the termlist).--- * UnsafeCons/UnsafeConsSym: like Cons and ConsSym but don't check---   that the termlist is non-empty.---- | Matches the empty termlist.-pattern Empty :: TermList f-pattern Empty <- (patHead -> Nothing)---- | Matches a non-empty termlist, unpacking it into head and tail.-pattern Cons :: Term f -> TermList f -> TermList f-pattern Cons t ts <- (patHead -> Just (t, _, ts))---- | Like 'Cons', but does not check that the termlist is non-empty. Use only if--- you are sure the termlist is non-empty.-pattern UnsafeCons :: Term f -> TermList f -> TermList f-pattern UnsafeCons t ts <- (unsafePatHead -> Just (t, _, ts))---- | Matches a non-empty termlist, unpacking it into head and--- /everything except the root symbol of the head/.--- Useful for iterating through terms one symbol at a time.------ For example, if @ts@ is the termlist @[f(x,y), g(z)]@,--- then @let ConsSym u us = ts@ results in the following bindings:------ > u  = f(x,y)--- > us = [x, y, g(z)]-pattern ConsSym :: Term f -> TermList f -> TermList f-pattern ConsSym t ts <- (patHead -> Just (t, ts, _))---- | Like 'ConsSym', but does not check that the termlist is non-empty. Use only--- if you are sure the termlist is non-empty.-pattern UnsafeConsSym :: Term f -> TermList f -> TermList f-pattern UnsafeConsSym t ts <- (unsafePatHead -> Just (t, ts, _))---- A helper for UnsafeCons/UnsafeConsSym.-{-# INLINE unsafePatHead #-}-unsafePatHead :: TermList f -> Maybe (Term f, TermList f, TermList f)-unsafePatHead TermList{..} =-  Just (Term x (TermList low (low+size) array),-        TermList (low+1) high array,-        TermList (low+size) high array)-  where-    !x = indexByteArray array low-    Symbol{..} = toSymbol x---- A helper for Cons/ConsSym.-{-# INLINE patHead #-}-patHead :: TermList f -> Maybe (Term f, TermList f, TermList f)-patHead t@TermList{..}-  | low == high = Nothing-  | otherwise = unsafePatHead t---- Pattern synonyms for single terms.--- * Var :: Var -> Term f--- * App :: Fun f -> TermList f -> Term f---- | A function symbol. @f@ is the underlying type of function symbols defined--- by the user; @'Fun' f@ is an @f@ together with an automatically-generated unique number.-newtype Fun f =-  F {-    -- | The unique number of a 'Fun'.-    fun_id :: Int }-instance Eq (Fun f) where-  f == g = fun_id f == fun_id g-instance Ord (Fun f) where-  compare = comparing fun_id---- | Construct a 'Fun' from a function symbol.-fun :: (Ord f, Typeable f) => f -> Fun f-fun f = F (fromIntegral (labelNum (label f)))---- | The underlying function symbol of a 'Fun'.-fun_value :: Fun f -> f-fun_value f = find (unsafeMkLabel (fromIntegral (fun_id f)))---- | A variable.-newtype Var =-  V {-    -- | The variable's number.-    -- Don't use huge variable numbers:-    -- they will be truncated to 32 bits when stored in a term.-    var_id :: Int } deriving (Eq, Ord, Enum)-instance Show (Fun f) where show f = "f" ++ show (fun_id f)-instance Show Var     where show x = "x" ++ show (var_id x)---- | Matches a variable.-pattern Var :: Var -> Term f-pattern Var x <- (patTerm -> Left x)---- | Matches a function application.-pattern App :: Fun f -> TermList f -> Term f-pattern App f ts <- (patTerm -> Right (f, ts))---- A helper function for Var and App.-{-# INLINE patTerm #-}-patTerm :: Term f -> Either Var (Fun f, TermList f)-patTerm t@Term{..}-  | isFun     = Right (F index, ts)-  | otherwise = Left (V index)-  where-    Symbol{..} = toSymbol root-    !(UnsafeConsSym _ ts) = singleton t---- | Convert a term to a termlist.-{-# INLINE singleton #-}-singleton :: Term f -> TermList f-singleton Term{..} = termlist---- We can implement equality almost without access to the--- internal representation of the termlists, but we cheat by--- comparing Int64s instead of Symbols.-instance Eq (TermList f) where-  -- Manual worker-wrapper to prevent too much from being inlined.-  t == u = eqTermList t u--{-# INLINE eqTermList #-}-eqTermList :: TermList f -> TermList f -> Bool-eqTermList-  (TermList (I# low1) (I# high1) (ByteArray array1))-  (TermList (I# low2) (I# high2) (ByteArray array2)) =-    weqTermList low1 high1 array1 low2 high2 array2---- Manually worker-wrapper transform the thing, ugh...-{-# NOINLINE weqTermList #-}-weqTermList ::-  Int# -> Int# -> ByteArray# ->-  Int# -> Int# -> ByteArray# ->-  Bool-weqTermList low1 high1 array1 low2 high2 array2 =-  lenList t == lenList u && eqSameLength t u-  where-    t = TermList (I# low1) (I# high1) (ByteArray array1)-    u = TermList (I# low2) (I# high2) (ByteArray array2)-    eqSameLength Empty !_ = True-    eqSameLength (ConsSym s1 t) (UnsafeConsSym s2 u) =-      root s1 == root s2 && eqSameLength t u--instance Ord (TermList f) where-  {-# INLINE compare #-}-  compare t u =-    case compare (lenList t) (lenList u) of-      EQ -> compareContents t u-      x  -> x--compareContents :: TermList f -> TermList f -> Ordering-compareContents Empty !_ = EQ-compareContents (ConsSym s1 t) (UnsafeConsSym s2 u) =-  case compare (root s1) (root s2) of-    EQ -> compareContents t u-    x  -> x------------------------------------------------------------------------------------- Building terms.------------------------------------------------------------------------------------- | A monoid for building terms.--- 'mempty' represents the empty termlist, while 'mappend' appends two termlists.-newtype Builder f =-  Builder {-    unBuilder ::-      -- Takes: the term array and size, and current position in the term.-      -- Returns the final position, which may be out of bounds.-      forall s. Builder1 s f }--type Builder1 s f = State# s -> MutableByteArray# s -> Int# -> Int# -> (# State# s, Int# #)--instance Monoid (Builder f) where-  {-# INLINE mempty #-}-  mempty = Builder built-  {-# INLINE mappend #-}-  Builder m1 `mappend` Builder m2 = Builder (m1 `then_` m2)---- Build a termlist from a Builder.--- Works by guessing an appropriate size, and retrying if that was too small.-{-# INLINE buildTermList #-}-buildTermList :: Builder f -> TermList f-buildTermList builder = runST $ do-  let-    Builder m = builder-    loop n@(I# n#) = do-      MutableByteArray mbytearray# <--        newByteArray (n * sizeOf (fromSymbol undefined))-      n' <--        ST $ \s ->-          case m s mbytearray# n# 0# of-            (# s, n# #) -> (# s, I# n# #)-      if n' <= n then do-        !bytearray <- unsafeFreezeByteArray (MutableByteArray mbytearray#)-        return (TermList 0 n' bytearray)-       else loop (n'*2)-  loop 32---- Get at the term array.-{-# INLINE getByteArray #-}-getByteArray :: (MutableByteArray s -> Builder1 s f) -> Builder1 s f-getByteArray k = \s bytearray n i -> k (MutableByteArray bytearray) s bytearray n i---- Get at the array size.-{-# INLINE getSize #-}-getSize :: (Int -> Builder1 s f) -> Builder1 s f-getSize k = \s bytearray n i -> k (I# n) s bytearray n i---- Get at the current array index.-{-# INLINE getIndex #-}-getIndex :: (Int -> Builder1 s f) -> Builder1 s f-getIndex k = \s bytearray n i -> k (I# i) s bytearray n i---- Change the current array index.-{-# INLINE putIndex #-}-putIndex :: Int -> Builder1 s f-putIndex (I# i) = \s _ _ _ -> (# s, i #)---- Lift an ST computation into a builder.-{-# INLINE liftST #-}-liftST :: ST s () -> Builder1 s f-liftST (ST m) =-  \s _ _ i ->-  case m s of-    (# s, () #) -> (# s, i #)---- Finish building.-{-# INLINE built #-}-built :: Builder1 s f-built = \s _ _ i -> (# s, i #)---- Sequence two builder operations.-{-# INLINE then_ #-}-then_ :: Builder1 s f -> Builder1 s f -> Builder1 s f-then_ m1 m2 =-  \s bytearray n i ->-    case m1 s bytearray n i of-      (# s, i #) -> m2 s bytearray n i---- checked j m executes m only if the array has room for j more symbols.-{-# INLINE checked #-}-checked :: Int -> Builder1 s f -> Builder1 s f-checked j m =-  getSize $ \n ->-  getIndex $ \i ->-  if i + j <= n then m else putIndex (i + j)---- Emit an arbitrary symbol, with given arguments.-{-# INLINE emitSymbolBuilder #-}-emitSymbolBuilder :: Symbol -> Builder f -> Builder f-emitSymbolBuilder x inner =-  Builder $ checked 1 $-    getByteArray $ \bytearray ->-    -- Skip the symbol itself, then fill it in at the end, when we know the size-    -- of the symbol's arguments.-    getIndex $ \n ->-    putIndex (n+1) `then_`-    unBuilder inner `then_`-    -- Fill in the symbol.-    getIndex (\m ->-      liftST $ writeByteArray bytearray n (fromSymbol x { size = m - n }))---- Emit a function application.-{-# INLINE emitApp #-}-emitApp :: Fun f -> Builder f -> Builder f-emitApp (F n) inner = emitSymbolBuilder (Symbol True n 0) inner---- Emit a variable.-{-# INLINE emitVar #-}-emitVar :: Var -> Builder f-emitVar x = emitSymbolBuilder (Symbol False (var_id x) 1) mempty---- Emit a whole termlist.-{-# INLINE emitTermList #-}-emitTermList :: TermList f -> Builder f-emitTermList (TermList lo hi array) =-  Builder $ checked (hi-lo) $-    getByteArray $ \mbytearray ->-    getIndex $ \n ->-    let k = sizeOf (fromSymbol undefined) in-    liftST (copyByteArray mbytearray (n*k) array (lo*k) ((hi-lo)*k)) `then_`-    putIndex (n + hi-lo)--------------------------------------------------------------------------- Efficient subterm testing.--------------------------------------------------------------------------- | Is a term contained as a subterm in a given termlist?-{-# INLINE isSubtermOfList #-}-isSubtermOfList :: Term f -> TermList f -> Bool-isSubtermOfList t u =-  isSubArrayOf (singleton t) u---- N.B. this one should not be exported from Twee.Term--- because subarray is not the same as subterm if t is not--- a singleton-isSubArrayOf :: TermList f -> TermList f -> Bool-isSubArrayOf t u =-  lenList t <= lenList u && (here t u || next t u)-  where-    here Empty _ = True-    here (ConsSym s1 t) (UnsafeConsSym s2 u) =-      root s1 == root s2 && here t u--    -- This is safe because lenList t <= lenList u-    -- so if u = Empty, then t = Empty and here t u = True.-    next t (UnsafeConsSym _ u) = isSubArrayOf t u---- | Check if a variable occurs in a termlist.-{-# INLINE occursList #-}-occursList :: Var -> TermList f -> Bool-occursList (V x) t = symbolOccursList (fromSymbol (Symbol False x 1)) t--symbolOccursList :: Int64 -> TermList f -> Bool-symbolOccursList !_ Empty = False-symbolOccursList n (ConsSym t ts) = root t == n || symbolOccursList n ts
− src/Twee/Utils.hs 
@@ -1,145 +0,0 @@--- | Miscellaneous utility functions.--{-# LANGUAGE CPP, MagicHash #-}-module Twee.Utils where--import Control.Arrow((&&&))-import Control.Exception-import Data.List(groupBy, sortBy)-import Data.Ord(comparing)-import System.IO-import GHC.Prim-import GHC.Types-import Data.Bits---import Test.QuickCheck hiding ((.&.))--repeatM :: Monad m => m a -> m [a]-repeatM = sequence . repeat--partitionBy :: Ord b => (a -> b) -> [a] -> [[a]]-partitionBy value =-  map (map fst) .-  groupBy (\x y -> snd x == snd y) .-  sortBy (comparing snd) .-  map (id &&& value)--collate :: Ord a => ([b] -> c) -> [(a, b)] -> [(a, c)]-collate f = map g . partitionBy fst-  where-    g xs = (fst (head xs), f (map snd xs))--isSorted :: Ord a => [a] -> Bool-isSorted xs = and (zipWith (<=) xs (tail xs))--isSortedBy :: Ord b => (a -> b) -> [a] -> Bool-isSortedBy f xs = isSorted (map f xs)--usort :: Ord a => [a] -> [a]-usort = usortBy compare--usortBy :: (a -> a -> Ordering) -> [a] -> [a]-usortBy f = map head . groupBy (\x y -> f x y == EQ) . sortBy f--sortBy' :: Ord b => (a -> b) -> [a] -> [a]-sortBy' f = map snd . sortBy (comparing fst) . map (\x -> (f x, x))--usortBy' :: Ord b => (a -> b) -> [a] -> [a]-usortBy' f = map snd . usortBy (comparing fst) . map (\x -> (f x, x))--orElse :: Ordering -> Ordering -> Ordering-EQ `orElse` x = x-x  `orElse` _ = x--unbuffered :: IO a -> IO a-unbuffered x = do-  buf <- hGetBuffering stdout-  bracket_-    (hSetBuffering stdout NoBuffering)-    (hSetBuffering stdout buf)-    x--newtype Max a = Max { getMax :: Maybe a }--getMaxWith :: Ord a => a -> Max a -> a-getMaxWith x (Max (Just y)) = x `max` y-getMaxWith x (Max Nothing)  = x--instance Ord a => Monoid (Max a) where-  mempty = Max Nothing-  Max (Just x) `mappend` y = Max (Just (getMaxWith x y))-  Max Nothing  `mappend` y = y--newtype Min a = Min { getMin :: Maybe a }--getMinWith :: Ord a => a -> Min a -> a-getMinWith x (Min (Just y)) = x `min` y-getMinWith x (Min Nothing)  = x--instance Ord a => Monoid (Min a) where-  mempty = Min Nothing-  Min (Just x) `mappend` y = Min (Just (getMinWith x y))-  Min Nothing  `mappend` y = y--labelM :: Monad m => (a -> m b) -> [a] -> m [(a, b)]-labelM f = mapM (\x -> do { y <- f x; return (x, y) })--#if __GLASGOW_HASKELL__ < 710-isSubsequenceOf :: Ord a => [a] -> [a] -> Bool-[] `isSubsequenceOf` ys = True-(x:xs) `isSubsequenceOf` [] = False-(x:xs) `isSubsequenceOf` (y:ys)-  | x == y = xs `isSubsequenceOf` ys-  | otherwise = (x:xs) `isSubsequenceOf` ys-#endif--{-# INLINE fixpoint #-}-fixpoint :: Eq a => (a -> a) -> a -> a-fixpoint f x = fxp x-  where-    fxp x-      | x == y = x-      | otherwise = fxp y-      where-        y = f x---- From "Bit twiddling hacks": branchless min and max-{-# INLINE intMin #-}-intMin :: Int -> Int -> Int-intMin x y =-  y `xor` ((x `xor` y) .&. negate (x .<. y))-  where-    I# x .<. I# y = I# (x <# y)--{-# INLINE intMax #-}-intMax :: Int -> Int -> Int-intMax x y =-  x `xor` ((x `xor` y) .&. negate (x .<. y))-  where-    I# x .<. I# y = I# (x <# y)---- Split an interval (inclusive bounds) into a particular number of blocks-splitInterval :: Integral a => a -> (a, a) -> [(a, a)]-splitInterval k (lo, hi) =-  [ (lo+i*blockSize, (lo+(i+1)*blockSize-1) `min` hi)-  | i <- [0..k-1] ]-  where-    size = (hi-lo+1)-    blockSize = (size + k - 1) `div` k -- division rounding up-{--prop_split_1 (Positive k) (lo, hi) =-  -- Check that all elements occur exactly once-  concat [[x..y] | (x, y) <- splitInterval k (lo, hi)] === [lo..hi]---- Check that we have the correct number and distribution of blocks-prop_split_2 (Positive k) (lo, hi) =-  counterexample (show splits) $ conjoin-    [counterexample "Reason: too many splits" $-       length splits <= k,-     counterexample "Reason: too few splits" $-       length [lo..hi] >= k ==> length splits == k,-     counterexample "Reason: uneven distribution" $-      not (null splits) ==>-       minimum (map length splits) + 1 >= maximum (map length splits)]-  where-    splits = splitInterval k (lo, hi)--}
− tests/BOO067-1.p 
@@ -1,32 +0,0 @@-%---------------------------------------------------------------------------% File     : BOO067-1 : TPTP v6.3.0. Released v2.6.0.-% Domain   : Boolean Algebra (Ternary)-% Problem  : Ternary Boolean Algebra Single axiom is complete, part 1-% Version  : [MP96] (equality) axioms.-% English  :--% Refs     : [McC98] McCune (1998), Email to G. Sutcliffe-%          : [MP96]  McCune & Padmanabhan (1996), Automated Deduction in Eq-% Source   : [TPTP]-% Names    :--% Status   : Unsatisfiable-% Rating   : 0.42 v6.3.0, 0.35 v6.2.0, 0.29 v6.1.0, 0.31 v6.0.0, 0.48 v5.5.0, 0.47 v5.4.0, 0.33 v5.3.0, 0.25 v5.2.0, 0.29 v5.1.0, 0.33 v5.0.0, 0.29 v4.1.0, 0.18 v4.0.1, 0.36 v4.0.0, 0.38 v3.7.0, 0.11 v3.4.0, 0.12 v3.3.0, 0.21 v3.1.0, 0.33 v2.7.0, 0.27 v2.6.0-% Syntax   : Number of clauses     :    2 (   0 non-Horn;   2 unit;   1 RR)-%            Number of atoms       :    2 (   2 equality)-%            Maximal clause size   :    1 (   1 average)-%            Number of predicates  :    1 (   0 propositional; 2-2 arity)-%            Number of functors    :    7 (   5 constant; 0-3 arity)-%            Number of variables   :    7 (   0 singleton)-%            Maximal term depth    :    5 (   3 average)-% SPC      : CNF_UNS_RFO_PEQ_UEQ--% Comments : A UEQ part of BOO035-1-%---------------------------------------------------------------------------cnf(single_axiom,axiom,-    ( multiply(multiply(A,inverse(A),B),inverse(multiply(multiply(C,D,E),F,multiply(C,D,G))),multiply(D,multiply(G,F,E),C)) = B )).--cnf(prove_tba_axioms_1,negated_conjecture,-    (  multiply(multiply(d,e,a),b,multiply(d,e,c)) != multiply(d,e,multiply(a,b,c)) )).--%--------------------------------------------------------------------------
− tests/LAT072-1.p 
@@ -1,37 +0,0 @@-%---------------------------------------------------------------------------% File     : LAT072-1 : TPTP v6.3.0. Released v2.6.0.-% Domain   : Lattice Theory (Ortholattices)-% Problem  : Given single axiom OML-23A, prove associativity-% Version  : [MRV03] (equality) axioms.-% English  : Given a single axiom candidate OML-23A for orthomodular lattices-%            (OML) in terms of the Sheffer Stroke, prove a Sheffer stroke form-%            of associativity.--% Refs     : [MRV03] McCune et al. (2003), Sheffer Stroke Bases for Ortholatt-% Source   : [MRV03]-% Names    : OML-23A-associativity [MRV03]--% Status   : Unsatisfiable-% Rating   : 0.95 v6.3.0, 0.94 v6.2.0, 0.93 v6.1.0, 0.94 v6.0.0, 0.95 v5.4.0, 1.00 v2.6.0-% Syntax   : Number of clauses     :    2 (   0 non-Horn;   2 unit;   1 RR)-%            Number of atoms       :    2 (   2 equality)-%            Maximal clause size   :    1 (   1 average)-%            Number of predicates  :    1 (   0 propositional; 2-2 arity)-%            Number of functors    :    4 (   3 constant; 0-2 arity)-%            Number of variables   :    4 (   2 singleton)-%            Maximal term depth    :    7 (   4 average)-% SPC      : CNF_UNS_RFO_PEQ_UEQ--% Comments :-%---------------------------------------------------------------------------%----Single axiom OML-23A-cnf(oml_23A,axiom,-    ( f(f(f(f(B,A),f(A,C)),D),f(A,f(f(C,f(f(A,A),C)),C))) = A )).--cnf(a, axiom, f(X,Y) = f(Y, X)).--%----Denial of Sheffer stroke associativity-cnf(associativity,negated_conjecture,-    (  f(a,f(f(b,c),f(b,c))) != f(c,f(f(b,a),f(b,a))) )).--%--------------------------------------------------------------------------
− tests/ROB010-1.p 
@@ -1,11 +0,0 @@-cnf(condition,hypothesis,-    ( negate(add(a,negate(b))) = c )).--cnf(prove_result,negated_conjecture,-    (  negate(add(c,negate(add(b,a)))) != a )).--cnf(commutativity_of_add,axiom,-    ( add(X,Y) = add(Y,X) )).--cnf(robbins_axiom,axiom,-    ( negate(add(negate(add(X,Y)),negate(add(X,negate(Y))))) = X )).
− tests/append-rev.p 
@@ -1,4 +0,0 @@-cnf(rev_rev, axiom, rev(rev(X)) = X).-cnf(app_assoc, axiom, '++'(X,'++'(Y,Z)) = '++'('++'(X,Y),Z)).-cnf(rev_app, axiom, '++'(rev(X),rev(Y)) = rev('++'(Y,X))).-cnf(conjecture, negated_conjecture, '++'(a,rev(b)) != rev('++'(b, rev(a)))).
− tests/db.p 
@@ -1,17 +0,0 @@-% http://www.dcs.bbk.ac.uk/~szabolcs/rellat-jlamp-second-submission-2.pdf-% appendix b. theorem 3.4, clause 8.-cnf(a, axiom, '^'(X, Y) = '^'(Y, X)).-cnf(a, axiom, '^'(X, '^'(Y, Z)) = '^'(Y, '^'(X, Z))).-cnf(a, axiom, '^'('^'(X, Y), Z) = '^'(X, '^'(Y, Z))).-cnf(a, axiom, v(X, Y) = v(Y, X)).-cnf(a, axiom, v(X, v(Y, Z)) = v(Y, v(X, Z))).-cnf(a, axiom, v(v(X, Y), Z) = v(X, v(Y, Z))).-cnf(a, axiom, v(X, '^'(X, Y)) = X).-cnf(a, axiom, '^'(X, v(X, Y)) = X).-cnf(a, axiom, upme(X,Y,Z) = '^'(X, v(Y, Z))).-cnf(a, axiom, lome(X,Y,Z) = v('^'(X, Y), '^'(X, Z))).-cnf(a, axiom, upjo(X,Y,Z) = '^'(v(X, Y), v(X, Z))).-cnf(a, axiom, lojo(X,Y,Z) = v(X, '^'(Y, Z))).-cnf(a, axiom, v(upme('^'(a, X1),Y1,Z1), '^'(Y1, Z1)) = '^'(v('^'('^'(a, X1), Y1), Z1), v('^'('^'(a, X1), Z1), Y1))).-cnf(a, axiom, upme(X,Y,Z) = v(upme(X,Y,'^'(a, Z)), upme(X,Z,'^'(a, Y)))).-fof(a, conjecture, (upme(a,x2,y2) = upme(a,x2,z2) => upme(x2,y2,z2) = lome(x2,y2,z2))).
− tests/deriv.p 
@@ -1,39 +0,0 @@-% Axioms about arithmetic.--cnf('commutativity of +', axiom,-	'+'(X, Y) = '+'(Y, X)).-cnf('associativity of +', axiom,-	'+'(X, '+'(Y, Z)) = '+'('+'(X, Y), Z)).-cnf('commutativity of *', axiom,-	'*'(X, Y) = '*'(Y, X)).-cnf('associativity of *', axiom,-	'*'(X, '*'(Y, Z)) = '*'('*'(X, Y), Z)).-cnf('plus 0', axiom,-	'+'('0', X) = X).-cnf('times 0', axiom,-	'*'('0', X) = '0').-cnf('times 1', axiom,-	'*'('1', X) = X).-cnf('distributivity', axiom,-	'*'(X, '+'(Y, Z)) = '+'('*'(X, Y), '*'(X, Z))).-cnf('minus', axiom,-    '+'(X, '-'(X)) = '0').--cnf('derivative of 0', axiom,-	d('0') = '0').-cnf('derivative of 1', axiom,-	d('1') = '0').-cnf('derivative of x', axiom,-	d(x) = '1').-cnf('derivative of +', axiom,-	d('+'(T,U)) = '+'(d(T), d(U))).-cnf('derivative of *', axiom,-	d('*'(T, U)) = '+'('*'(T, d(U)), '*'(U, d(T)))).-cnf('derivative of sin', axiom,-    d(sin(T)) = '*'(cos(T), d(T))).-cnf('derivative of cos', axiom,-    d(cos(T)) = '-'('*'(sin(T), d(T)))).--fof(goal, conjecture,-	?[T]: d(T) = '*'(x, cos(x))).-
− tests/diff.p 
@@ -1,4 +0,0 @@-cnf('x\\(y\\x)=x', axiom, '\\'(X, '\\'(Y, X)) = X).-cnf('x\\(x\\y)=y\\(y\\x)', axiom, '\\'(X, '\\'(X, Y)) = '\\'(Y, '\\'(Y, X))).-cnf('(x\\y)\\z=(x\\z)\\(y\\z)', axiom, '\\'('\\'(X, Y), Z) = '\\'('\\'(X, Z), '\\'(Y, Z))).-cnf(conjecture, negated_conjecture, '\\'('\\'(a, c), b) != '\\'('\\'(a, b), c)).
− tests/group.p 
@@ -1,15 +0,0 @@-fof(identity, axiom,-    ![X]: f(X, e) = X).-fof(right_inverse, axiom,-    ![X]: f(X, i(X)) = e).-fof(associativity, axiom,-    ![X, Y, Z]: f(X, f(Y, Z)) = f(f(X, Y), Z)).-%fof(left_inverse, conjecture,-%    ![X]: f(i(X),X) = e).-%fof(left_identity, conjecture,-%    ![X]: f(e, X) = X).--fof(inverse_distrib, axiom,-    ![X,Y]: f(i(X),i(Y)) = i(f(X,Y))).-fof(commutativity, conjecture,-    ![X,Y]: f(X,Y) = f(Y,X)).
− tests/lat.p 
@@ -1,16 +0,0 @@-cnf(idempotence_of_meet, axiom, meet(X, X)=X).-cnf(idempotence_of_join, axiom, join(X, X)=X).-cnf(absorption1, axiom, meet(X, join(X, Y))=X).-cnf(absorption2, axiom, join(X, meet(X, Y))=X).-cnf(commutativity_of_meet, axiom, meet(X, Y)=meet(Y, X)).-cnf(commutativity_of_join, axiom, join(X, Y)=join(Y, X)).-cnf(associativity_of_meet, axiom,-    meet(meet(X, Y), Z)=meet(X, meet(Y, Z))).-cnf(associativity_of_join, axiom,-    join(join(X, Y), Z)=join(X, join(Y, Z))).-cnf(equation_H34, axiom,-    meet(X, join(Y, meet(Z, U)))=meet(X,-                                      join(Y, meet(Z, join(Y, meet(U, join(Y, Z))))))).-cnf(prove_H28, negated_conjecture,-    meet(a, join(b, meet(a, meet(c, d))))!=meet(a,-                                                join(b, meet(c, meet(d, join(a, meet(b, d))))))).
− tests/lcl.p 
@@ -1,7 +0,0 @@-cnf(wajsberg_1, axiom, implies(truth, X)=X).-cnf(wajsberg_3, axiom,-    implies(implies(X, Y), Y)=implies(implies(Y, X), X)).-cnf(wajsberg_4, axiom,-    implies(implies(not(X), not(Y)), implies(Y, X))=truth).-cnf(lemma_antecedent, axiom, implies(X, Y)=implies(Y, X)).-cnf(prove_wajsberg_lemma, negated_conjecture, x!=y).
− tests/loop.p 
@@ -1,6 +0,0 @@-cnf(mult_ld, axiom, '*'(X, '^'(X, Y)) = Y).-cnf(ld_mult, axiom, '^'(X, '*'(X, Y)) = Y).-cnf(mult_rd, axiom, '*'('/'(X, Y), Y) = X).-cnf(rd_mult, axiom, '/'('*'(X, Y), Y) = X).-cnf(moufang, axiom, '*'(X, '*'(Y, '*'(X, Z))) = '*'('*'('*'(X, Y), X), Z)).-cnf(conjecture, negated_conjecture, '^'(a,a) != '/'(a,a)).
− tests/loop2.p 
@@ -1,6 +0,0 @@-cnf('*-\\', axiom, '*'(X, '\\'(X, Y)) = Y).-cnf('\\-*', axiom, '\\'(X, '*'(X, Y)) = Y).-cnf('*-/', axiom, '*'('/'(X, Y), Y) = X).-cnf('/-*', axiom, '/'('*'(X, Y), Y) = X).-cnf(moufang, axiom, '*'(X, '*'(Y, '*'(X, Z))) = '*'('*'('*'(X, Y), X), Z)).-cnf(conjecture, negated_conjecture, '*'(a,'/'(b,b)) != a).
− tests/lukasiewicz.p 
@@ -1,6 +0,0 @@-cnf(imp_true, axiom, implies(true, X) = X).-cnf(imp_compose, axiom, implies(implies(X, Y), implies(implies(Y, Z), implies(X, Z))) = true).-cnf(imp_not, axiom, implies(implies(not(X), not(Y)), implies(Y, X)) = true).-cnf(imp_switch, axiom, implies(implies(X, Y), Y) = implies(implies(Y, X), X)).-cnf(or_def, axiom, or(X, Y) = implies(not(X), Y)).-cnf(conjecture, negated_conjecture, or(a,or(b,c)) != or(or(a,b),c)).
− tests/minus.p 
@@ -1,12 +0,0 @@-cnf(plus_zero, axiom,-	'+'('0', X) = X).-cnf(plus_zero, axiom,-	'+'(X, '0') = X).-cnf(minus_minus, axiom,-	'-'('-'(X)) = X).-cnf(minus_plus, axiom,-	'-'('+'(X, Y)) = '+'('-'(X), '-'(Y))).--cnf(goal, conjecture,-    '-'('0') = '0').-	%% ?[Y]: d(Y) = '+'(x, x)).
− tests/nand.p 
@@ -1,37 +0,0 @@-%---------------------------------------------------------------------------% File     : LAT071-1 : TPTP v6.2.0. Released v2.6.0.-% Domain   : Lattice Theory (Orthomodularlattices)-% Problem  : Given single axiom OML-21C, prove associativity-% Version  : [MRV03] (equality) axioms.-% English  : Given a single axiom candidate OML-21C for orthomodular lattices-%            (OML) in terms of the Sheffer Stroke, prove a Sheffer stroke form-%            of associativity.--% Refs     : [MRV03] McCune et al. (2003), Sheffer Stroke Bases for Ortholatt-% Source   : [MRV03]-% Names    : OML-21C-associativity [MRV03]--% Status   : Open-% Rating   : 1.00 v2.6.0-% Syntax   : Number of clauses     :    2 (   0 non-Horn;   2 unit;   1 RR)-%            Number of atoms       :    2 (   2 equality)-%            Maximal clause size   :    1 (   1 average)-%            Number of predicates  :    1 (   0 propositional; 2-2 arity)-%            Number of functors    :    4 (   3 constant; 0-2 arity)-%            Number of variables   :    4 (   2 singleton)-%            Maximal term depth    :    6 (   4 average)-% SPC      : CNF_UNK_UEQ--% Comments :-%---------------------------------------------------------------------------%----Single axiom OML-21C-cnf(oml_21C,axiom,-    ( f(f(B,A),f(f(f(f(B,A),A),f(C,A)),f(f(A,A),D))) = A )).--cnf(a, axiom, f(z, f(z, z)) = k).--%----Denial of Sheffer stroke associativity-cnf(associativity,negated_conjecture,-    (  f(a,f(f(b,c),f(b,c))) != f(c,f(f(b,a),f(b,a))) )).--%--------------------------------------------------------------------------
− tests/nicomachus.p 
@@ -1,18 +0,0 @@-cnf(plus_comm, axiom, plus(X, Y) = plus(Y, X)).-cnf(plus_assoc, axiom, plus(X, plus(Y, Z)) = plus(plus(X, Y), Z)).-cnf(times_comm, axiom, times(X, Y) = times(Y, X)).-cnf(times_assoc, axiom, times(X, times(Y, Z)) = times(times(X, Y), Z)).-cnf(plus_zero, axiom, plus(X, zero) = X).-cnf(times_zero, axiom, times(X, zero) = zero).-cnf(times_one, axiom, times(X, one) = X).-cnf(distr, axiom, times(X, plus(Y, Z)) = plus(times(X, Y), times(X, Z))).-cnf(distr, axiom, times(plus(X, Y), Z) = plus(times(X, Z), times(Y, Z))).-cnf(plus_s, axiom, plus(s(X), Y) = s(plus(X, Y))).-cnf(times_s, axiom, times(s(X), Y) = plus(Y, times(X, Y))).-cnf(sum_zero, axiom, sum(zero) = zero).-cnf(sum_s, axiom, sum(s(N)) = plus(s(N), sum(N))).-cnf(cubes_zero, axiom, cubes(zero) = zero).-cnf(cubes_s, axiom, cubes(s(N)) = plus(times(s(N), times(s(N), s(N))), cubes(N))).-cnf(plus_sum, axiom, plus(sum(N), sum(N)) = times(N, s(N))).-cnf(ih, axiom, times(sum(a), sum(a)) = cubes(a)).-cnf(conjecture, negated_conjecture, times(sum(s(a)), sum(s(a))) != cubes(s(a))).
− tests/ring.p 
@@ -1,9 +0,0 @@-cnf(plus_comm, axiom, '+'(X, Y) = '+'(Y, X)).-cnf(plus_assoc, axiom, '+'(X, '+'(Y, Z)) = '+'('+'(X, Y), Z)).-cnf(plus_zero, axiom, '+'('0', X) = X).-cnf(plus_inv, axiom, '+'(X, '-'(X)) = '0').-cnf(times_assoc, axiom, '*'(X, '*'(Y, Z)) = '*'('*'(X, Y), Z)).-cnf(distrib, axiom, '*'(X, '+'(Y, Z)) = '+'('*'(X, Y), '*'(X, Z))).-cnf(distrib, axiom, '*'('+'(X, Y), Z) = '+'('*'(X, Z), '*'(Y, Z))).-cnf(cube, axiom, X = '*'(X, '*'(X, X))).-cnf(conjecture, negated_conjecture, '*'(a, b) != '*'(b, a)).
− tests/ring2.p 
@@ -1,9 +0,0 @@-cnf(plus_comm, axiom, '+'(X, Y) = '+'(Y, X)).-cnf(plus_assoc, axiom, '+'(X, '+'(Y, Z)) = '+'('+'(X, Y), Z)).-cnf(plus_zero, axiom, '+'('0', X) = X).-cnf(plus_inv, axiom, '+'(X, '-'(X)) = '0').-cnf(times_assoc, axiom, '*'(X, '*'(Y, Z)) = '*'('*'(X, Y), Z)).-cnf(distrib, axiom, '*'(X, '+'(Y, Z)) = '+'('*'(X, Y), '*'(X, Z))).-cnf(distrib, axiom, '*'('+'(X, Y), Z) = '+'('*'(X, Z), '*'(Y, Z))).-cnf(power_six, axiom, X = '*'(X, '*'(X, '*'(X, '*'(X, '*'(X, X)))))).-cnf(conjecture, negated_conjecture, '*'(a, b) != '*'(b, a)).
− tests/ring3.p 
@@ -1,9 +0,0 @@-cnf(plus_comm, axiom, '+'(X, Y) = '+'(Y, X)).-cnf(plus_assoc, axiom, '+'(X, '+'(Y, Z)) = '+'('+'(X, Y), Z)).-cnf(plus_zero, axiom, '+'('0', X) = X).-cnf(plus_neg, axiom, '+'(X, '-'(X)) = '0').-cnf(times_assoc, axiom, '*'(X, '*'(Y, Z)) = '*'('*'(X, Y), Z)).-cnf(distrib, axiom, '*'(X, '+'(Y, Z)) = '+'('*'(X, Y), '*'(X, Z))).-cnf(distrib, axiom, '*'('+'(X, Y), Z) = '+'('*'(X, Z), '*'(Y, Z))).-cnf(power_four, axiom, X = '*'(X, '*'(X, '*'(X, X)))).-cnf(conjecture, negated_conjecture, '*'(a, b) != '*'(b, a)).
− tests/ring4.p 
@@ -1,9 +0,0 @@-cnf(plus_comm, axiom, '+'(X, Y) = '+'(Y, X)).-cnf(plus_assoc, axiom, '+'(X, '+'(Y, Z)) = '+'('+'(X, Y), Z)).-cnf(plus_zero, axiom, '+'('0', X) = X).-cnf(plus_inv, axiom, '+'(X, '-'(X)) = '0').-cnf(times_ssoc, axiom, '*'(X, '*'(Y, Z)) = '*'('*'(X, Y), Z)).-cnf(distrib, axiom, '*'(X, '+'(Y, Z)) = '+'('*'(X, Y), '*'(X, Z))).-cnf(distrib, axiom, '*'('+'(X, Y), Z) = '+'('*'(X, Z), '*'(Y, Z))).-cnf(power_five, axiom, X = '*'(X, '*'(X, '*'(X, '*'(X, X))))).-cnf(conjecture, negated_conjecture, '*'(a, b) != '*'(b, a)).
− tests/robbins-easy.p 
@@ -1,4 +0,0 @@-cnf(comm, axiom, '+'(X, Y) = '+'(Y, X)).-cnf(assoc, axiom, '+'(X, '+'(Y, Z)) = '+'('+'(X, Y), Z)).-cnf(funny, axiom, '+'('-'('+'('-'(X), Y)), '-'('+'('-'(X), '-'(Y)))) = X).-cnf(conjecture, negated_conjecture, '-'('+'('-'('+'(a, b)), '-'('+'(a, '-'(b))))) != a).
− tests/robbins.p 
@@ -1,4 +0,0 @@-cnf(comm, axiom, '+'(X, Y) = '+'(Y, X)).-cnf(assoc, axiom, '+'(X, '+'(Y, Z)) = '+'('+'(X, Y), Z)).-cnf(funny, axiom, '-'('+'('-'('+'(X, Y)), '-'('+'(X, '-'(Y))))) = X).-cnf(conjecture, negated_conjecture, '-'('-'(a)) != a).
− tests/sam.p 
@@ -1,38 +0,0 @@-cnf(f_assoc, axiom,-    meet(X,meet(Y,Z)) = meet(meet(X,Y),Z)).-cnf(f_comm, axiom,-    meet(X,Y) = meet(Y,X)).-cnf(f_idem, axiom,-    meet(X,X) = X).-cnf(g_assoc, axiom,-    join(X,join(Y,Z)) = join(join(X,Y),Z)).-cnf(g_comm, axiom,-    join(X,Y) = join(Y,X)).-cnf(g_idem, axiom,-    join(X,X) = X).--cnf(ax31, axiom,-    meet(X, join(X,Y)) = X).-cnf(ax32, axiom,-    meet(zero, X) = zero).-cnf(ax33, axiom,-    join(zero, X) = X).-cnf(ax34, axiom,-    join(X, meet(X, Y)) = X).-cnf(ax35, axiom,-    meet(one, X) = X).-cnf(ax36, axiom,-    join(one, X) = one).-cnf(ax37, axiom,-    meet(X,Z) = X =>-    meet(join(X,Y),Z) = join(X,meet(Y,Z))).--cnf(comp, definition,-    comp(X,Y) <=> (meet(X,Y) = zero & join(X,Y) = one)).--cnf(premise1, assumption,-    comp(a, join(c,d))).-cnf(premise2, assumption,-    comp(b, join(c,d))).-cnf(goal, conjecture,-    meet(join(a,meet(b,c)),join(a,meet(b,d)))=a).
− tests/semigroup.p 
@@ -1,4 +0,0 @@-cnf(assoc, axiom, '*'(X, '*'(Y, Z)) = '*'('*'(X, Y), Z)).-cnf(two_three, axiom, '*'(X, X) = '*'(X, '*'(X, X))).-cnf(twiddle, axiom, '*'('*'(X, X), Y) = '*'(Y, '*'(X, X))).-cnf(conjecture, negated_conjecture, '*'('*'(a, b), '*'(a, b)) != '*'('*'(a, a), '*'(b, b))).
− tests/semigroup2.p 
@@ -1,26 +0,0 @@-% File     : GRP196-1 : TPTP v6.1.0. Released v2.2.0.-% Domain   : Group Theory (Semigroups)-% Problem  : In semigroups, xyyy=yyyx -> (uy)^9 = u^9v^9.-% Version  : [MP96] (equality) axioms.-% English  :-% Refs     : [McC98] McCune (1998), Email to G. Sutcliffe-%          : [MP96]  McCune & Padmanabhan (1996), Automated Deduction in Eq-%          : [McC95] McCune (1995), Four Challenge Problems in Equational L-% Source   : [McC98]-% Names    : CS-3 [MP96]-%          : Problem B [McC95]-% Status   : Unsatisfiable-% Rating   : 1.00 v4.0.1, 0.93 v4.0.0, 0.92 v3.7.0, 0.89 v3.4.0, 1.00 v3.3.0, 0.93 v3.1.0, 1.00 v2.2.1-% Syntax   : Number of clauses     :    3 (   0 non-Horn;   3 unit;   1 RR)-%            Number of atoms       :    3 (   3 equality)-%            Maximal clause size   :    1 (   1 average)-%            Number of predicates  :    1 (   0 propositional; 2-2 arity)-%            Number of functors    :    3 (   2 constant; 0-2 arity)-%            Number of variables   :    5 (   0 singleton)-%            Maximal term depth    :   18 (   8 average)-% SPC      : CNF_UNS_RFO_PEQ_UEQ-% Comments : The problem was originally posed for cancellative semigroups,-%            Otter does this with a nonstandard representation [MP96].-cnf(assoc, axiom, '*'('*'(A,B),C)='*'(A,'*'(B,C))).-cnf(twiddle, axiom, '*'(A,'*'(B,'*'(B,B)))='*'(B,'*'(B,'*'(B,A)))).-cnf(conjecture, negated_conjecture, '*'(a,'*'(b,'*'(a,'*'(b,'*'(a,'*'(b,'*'(a,'*'(b,'*'(a,'*'(b,'*'(a,'*'(b,'*'(a,'*'(b,'*'(a,'*'(b,'*'(a,b))))))))))))))))) != '*'(a,'*'(a,'*'(a,'*'(a,'*'(a,'*'(a,'*'(a,'*'(a,'*'(a,'*'(b,'*'(b,'*'(b,'*'(b,'*'(b,'*'(b,'*'(b,'*'(b,b)))))))))))))))))).
− tests/veroff.p 
@@ -1,10 +0,0 @@-cnf(majority, axiom,-    f(X,X,Y) = X).-cnf('2a', axiom,-    f(X,Y,Z) = f(Z,X,Y)).-cnf('2b', axiom,-    f(X,Y,Z) = f(X,Z,Y)).-cnf(associativity, axiom,-    f(f(X,W,Y),W,Z) = f(X,W,f(Y,W,Z))).--cnf(goal, axiom, f(f(a1,a2,a3),a4,a5) != f(f(a1,a4,a5),f(a2,a4,a5),f(a3,a4,a5))).
− tests/winkler-easy.p 
@@ -1,6 +0,0 @@-% Needs case split on X < c.-cnf(comm, axiom, '+'(X, Y) = '+'(Y, X)).-cnf(assoc, axiom, '+'(X, '+'(Y, Z)) = '+'('+'(X, Y), Z)).-cnf(idem, axiom, '+'(X, X) = X).-cnf(funny, axiom, '-'('+'('-'('+'(X, Y)), '-'('+'(X, '-'(Y))))) = X).-cnf(conjecture, negated_conjecture, '+'('-'('+'('-'(a), b)), '-'('+'('-'(a), '-'(b)))) != a).
− tests/winkler.p 
@@ -1,6 +0,0 @@-% Needs case split on X < c.-cnf(comm, axiom, '+'(X, Y) = '+'(Y, X)).-cnf(assoc, axiom, '+'(X, '+'(Y, Z)) = '+'('+'(X, Y), Z)).-cnf(idem_c, axiom, '+'(c, c) = c).-cnf(funny, axiom, '-'('+'('-'('+'(X, Y)), '-'('+'(X, '-'(Y))))) = X).-cnf(conjecture, negated_conjecture, '+'('-'('+'('-'(a), b)), '-'('+'('-'(a), '-'(b)))) != a).
− tests/winkler2.p 
@@ -1,6 +0,0 @@-% Needs case split on X < c.-cnf(comm, axiom, '+'(X, Y) = '+'(Y, X)).-cnf(assoc, axiom, '+'(X, '+'(Y, Z)) = '+'('+'(X, Y), Z)).-cnf(plus_c_d, axiom, '+'(c, d) = c).-cnf(funny, axiom, '-'('+'('-'('+'(X, Y)), '-'('+'(X, '-'(Y))))) = X).-cnf(conjecture, negated_conjecture, '+'('-'('+'('-'(a), b)), '-'('+'('-'(a), '-'(b)))) != a).
− tests/y.p 
@@ -1,3 +0,0 @@-fof(k_def, axiom, ![X, Y]: '@'('@'(k, X), Y) = X).-fof(s_def, axiom, ![X, Y, Z]: '@'('@'('@'(s, X), Y), Z) = '@'('@'(X, Z), '@'(Y, Z))).-fof(conjecture, conjecture, ?[Y]: ![F]: '@'(Y, F) = '@'(F, '@'(Y, F))).
twee-lib.cabal view
@@ -1,5 +1,5 @@ name:                twee-lib-version:             2.1+version:             2.1.1 synopsis:            An equational theorem prover homepage:            http://github.com/nick8325/twee license:             BSD3@@ -9,7 +9,6 @@ category:            Theorem Provers build-type:          Simple cabal-version:       >=1.10-extra-source-files:  README.md tests/*.p misc/*.hs misc/*.pl misc/static-libstdc++ description:    Twee is an experimental equational theorem prover based on    Knuth-Bendix completion.@@ -80,7 +79,7 @@     ghc-prim,     primitive >= 0.6.2.0,     vector-  hs-source-dirs:      src+  hs-source-dirs:      .   ghc-options:         -W -fno-warn-incomplete-patterns -O2 -fmax-worker-args=100   default-language:    Haskell2010