-----------------------------------------------------------------------------
-- |
-- Module    : Data.SBV.TP.TP
-- Copyright : (c) Levent Erkok
-- License   : BSD3
-- Maintainer: erkokl@gmail.com
-- Stability : experimental
-----------------------------------------------------------------------------

{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeAbstractions           #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilyDependencies     #-}
{-# LANGUAGE TypeOperators              #-}

{-# OPTIONS_GHC -Wall -Werror #-}

module Data.SBV.TP.TP (
         Proposition, Proof, proofOf, assumptionFromProof, Instantiatable(..), Inst(..)
       , rootOfTrust, RootOfTrust(..), ProofTree(..), showProofTree, showProofTreeHTML
       ,   axiom
       ,   lemma,   lemmaWith
       ,    calc,    calcWith
       ,  induct,  inductWith
       , sInduct, sInductWith
       , sorry
       , TP, runTP, runTPWith, tpQuiet, tpRibbon, tpStats, tpCache
       , (|-), (⊢), (=:), (≡), (??), (∵), split, split2, cases, (==>), (⟹), qed, trivial, contradiction
       , qc, qcWith
       , disp
       ) where

import Data.SBV
import Data.SBV.Core.Model (qSaturateSavingObservables)
import Data.SBV.Core.Data  (SBV(..), SVal(..))
import qualified Data.SBV.Core.Symbolic as S (sObserve)

import Data.SBV.Core.Operations (svEqual)
import Data.SBV.Control hiding (getProof)

import Data.SBV.TP.Kernel
import Data.SBV.TP.Utils

import qualified Data.SBV.List as SL

import Control.Monad (when)
import Control.Monad.Trans (liftIO)

import Data.Char  (isSpace)
import Data.List  (intercalate, isPrefixOf, isSuffixOf)
import Data.Maybe (catMaybes, maybeToList)

import Data.Proxy
import Data.Kind    (Type)
import GHC.TypeLits (KnownSymbol, symbolVal, Symbol)

import Data.SBV.Utils.TDiff

import Data.Dynamic

import qualified Test.QuickCheck as QC
import Test.QuickCheck (quickCheckWithResult)

-- | Captures the steps for a calculationa proof
data CalcStrategy = CalcStrategy { CalcStrategy -> SBool
calcIntros     :: SBool
                                 , CalcStrategy -> TPProof
calcProofTree  :: TPProof
                                 , CalcStrategy -> [Int] -> Symbolic SBool
calcQCInstance :: [Int] -> Symbolic SBool
                                 }

-- | Saturatable things in steps
proofTreeSaturatables :: TPProof -> [SBool]
proofTreeSaturatables :: TPProof -> [SBool]
proofTreeSaturatables = TPProof -> [SBool]
go
  where go :: TPProof -> [SBool]
go (ProofEnd    SBool
b           [Helper]
hs                ) = SBool
b SBool -> [SBool] -> [SBool]
forall a. a -> [a] -> [a]
: (Helper -> [SBool]) -> [Helper] -> [SBool]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Helper -> [SBool]
getH [Helper]
hs
        go (ProofStep   SBool
a           [Helper]
hs               TPProof
r) = SBool
a SBool -> [SBool] -> [SBool]
forall a. a -> [a] -> [a]
: (Helper -> [SBool]) -> [Helper] -> [SBool]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Helper -> [SBool]
getH [Helper]
hs [SBool] -> [SBool] -> [SBool]
forall a. [a] -> [a] -> [a]
++ TPProof -> [SBool]
go TPProof
r
        go (ProofBranch (Bool
_ :: Bool) ([String]
_ :: [String]) [(SBool, TPProof)]
ps) = [[SBool]] -> [SBool]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [SBool
b SBool -> [SBool] -> [SBool]
forall a. a -> [a] -> [a]
: TPProof -> [SBool]
go TPProof
p | (SBool
b, TPProof
p) <- [(SBool, TPProof)]
ps]

        getH :: Helper -> [SBool]
getH (HelperProof  ProofObj
p) = [ProofObj -> SBool
getObjProof ProofObj
p]
        getH (HelperAssum  SBool
b) = [SBool
b]
        getH HelperQC{}       = []
        getH HelperString{}   = []
        getH (HelperDisp String
_ SVal
v) = [SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal
v SVal -> SVal -> SVal
`svEqual` SVal
v)]

-- | Things that are inside calc-strategy that we have to saturate
getCalcStrategySaturatables :: CalcStrategy -> [SBool]
getCalcStrategySaturatables :: CalcStrategy -> [SBool]
getCalcStrategySaturatables (CalcStrategy SBool
calcIntros TPProof
calcProofTree [Int] -> Symbolic SBool
_calcQCInstance) = SBool
calcIntros SBool -> [SBool] -> [SBool]
forall a. a -> [a] -> [a]
: TPProof -> [SBool]
proofTreeSaturatables TPProof
calcProofTree

-- | Propagate the settings for ribbon/timing from top to current. Because in any subsequent configuration
-- in a lemmaWith, inductWith etc., we just want to change the solver, not the actual settings for TP.
tpMergeCfg :: SMTConfig -> SMTConfig -> SMTConfig
tpMergeCfg :: SMTConfig -> SMTConfig -> SMTConfig
tpMergeCfg SMTConfig
cur SMTConfig
top = SMTConfig
cur{tpOptions = tpOptions top}

-- | Use an injective type family to allow for curried use of calc and strong induction steps.
type family StepArgs a t = result | result -> t where
  StepArgs                                                                             SBool  t =                                               (SBool, TPProofRaw (SBV t))
  StepArgs (Forall na a                                                             -> SBool) t = (SBV a                                     -> (SBool, TPProofRaw (SBV t)))
  StepArgs (Forall na a -> Forall nb b                                              -> SBool) t = (SBV a -> SBV b                            -> (SBool, TPProofRaw (SBV t)))
  StepArgs (Forall na a -> Forall nb b -> Forall nc c                               -> SBool) t = (SBV a -> SBV b -> SBV c                   -> (SBool, TPProofRaw (SBV t)))
  StepArgs (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d                -> SBool) t = (SBV a -> SBV b -> SBV c -> SBV d          -> (SBool, TPProofRaw (SBV t)))
  StepArgs (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) t = (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))

-- | Use an injective type family to allow for curried use of measures in strong induction instances
type family MeasureArgs a t = result | result -> t where
  MeasureArgs                                                                             SBool  t = (                                             SBV t)
  MeasureArgs (Forall na a                                                             -> SBool) t = (SBV a                                     -> SBV t)
  MeasureArgs (Forall na a -> Forall nb b                                              -> SBool) t = (SBV a -> SBV b                            -> SBV t)
  MeasureArgs (Forall na a -> Forall nb b -> Forall nc c                               -> SBool) t = (SBV a -> SBV b -> SBV c                   -> SBV t)
  MeasureArgs (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d                -> SBool) t = (SBV a -> SBV b -> SBV c -> SBV d          -> SBV t)
  MeasureArgs (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) t = (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV t)

-- | Use an injective type family to allow for curried use of regular induction steps. The first argument is the inductive arg that comes separately,
-- and hence is not used in the right-hand side of the equation.
type family IStepArgs a t = result | result -> t where
  IStepArgs ( Forall nx x                                                                                          -> SBool) t =                                               (SBool, TPProofRaw (SBV t))
  IStepArgs ( Forall nx x               -> Forall na a                                                             -> SBool) t = (SBV a ->                                     (SBool, TPProofRaw (SBV t)))
  IStepArgs ( Forall nx x               -> Forall na a -> Forall nb b                                              -> SBool) t = (SBV a -> SBV b                            -> (SBool, TPProofRaw (SBV t)))
  IStepArgs ( Forall nx x               -> Forall na a -> Forall nb b -> Forall nc c                               -> SBool) t = (SBV a -> SBV b -> SBV c                   -> (SBool, TPProofRaw (SBV t)))
  IStepArgs ( Forall nx x               -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d                -> SBool) t = (SBV a -> SBV b -> SBV c -> SBV d          -> (SBool, TPProofRaw (SBV t)))
  IStepArgs ( Forall nx x               -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) t = (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
  IStepArgs ((Forall nx x, Forall ny y)                                                                            -> SBool) t =                                               (SBool, TPProofRaw (SBV t))
  IStepArgs ((Forall nx x, Forall ny y) -> Forall na a                                                             -> SBool) t = (SBV a ->                                     (SBool, TPProofRaw (SBV t)))
  IStepArgs ((Forall nx x, Forall ny y) -> Forall na a -> Forall nb b                                              -> SBool) t = (SBV a -> SBV b                            -> (SBool, TPProofRaw (SBV t)))
  IStepArgs ((Forall nx x, Forall ny y) -> Forall na a -> Forall nb b -> Forall nc c                               -> SBool) t = (SBV a -> SBV b -> SBV c                   -> (SBool, TPProofRaw (SBV t)))
  IStepArgs ((Forall nx x, Forall ny y) -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d                -> SBool) t = (SBV a -> SBV b -> SBV c -> SBV d          -> (SBool, TPProofRaw (SBV t)))
  IStepArgs ((Forall nx x, Forall ny y) -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) t = (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))

-- | A class for doing equational reasoning style calculational proofs. Use 'calc' to prove a given theorem
-- as a sequence of equalities, each step following from the previous.
class Calc a where
  -- | Prove a property via a series of equality steps, using the default solver.
  -- Let @H@ be a list of already established lemmas. Let @P@ be a property we wanted to prove, named @name@.
  -- Consider a call of the form @calc name P (cond, [A, B, C, D]) H@. Note that @H@ is
  -- a list of already proven facts, ensured by the type signature. We proceed as follows:
  --
  --    * Prove: @(H && cond)                                   -> (A == B)@
  --    * Prove: @(H && cond && A == B)                         -> (B == C)@
  --    * Prove: @(H && cond && A == B && B == C)               -> (C == D)@
  --    * Prove: @(H && (cond -> (A == B && B == C && C == D))) -> P@
  --    * If all of the above steps succeed, conclude @P@.
  --
  -- cond acts as the context. Typically, if you are trying to prove @Y -> Z@, then you want cond to be Y.
  -- (This is similar to @intros@ commands in theorem provers.)
  --
  -- So, calc-lemma is essentially modus-ponens, applied in a sequence of stepwise equality reasoning in the case of
  -- non-boolean steps.
  --
  -- If there are no helpers given (i.e., if @H@ is empty), then this call is equivalent to 'lemmaWith'.
  calc :: (Proposition a, SymVal t, EqSymbolic (SBV t)) => String -> a -> StepArgs a t -> TP (Proof a)

  -- | Prove a property via a series of equality steps, using the given solver.
  calcWith :: (Proposition a, SymVal t, EqSymbolic (SBV t)) => SMTConfig -> String -> a -> StepArgs a t -> TP (Proof a)

  -- | Internal, shouldn't be needed outside the library
  {-# MINIMAL calcSteps #-}
  calcSteps :: (SymVal t, EqSymbolic (SBV t)) => a -> StepArgs a t -> Symbolic (SBool, CalcStrategy)

  calc         String
nm a
p StepArgs a t
steps = TP SMTConfig
getTPConfig TP SMTConfig -> (SMTConfig -> TP (Proof a)) -> TP (Proof a)
forall a b. TP a -> (a -> TP b) -> TP b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SMTConfig
cfg  -> SMTConfig -> String -> a -> StepArgs a t -> TP (Proof a)
forall t.
(Proposition a, SymVal t, EqSymbolic (SBV t)) =>
SMTConfig -> String -> a -> StepArgs a t -> TP (Proof a)
forall a t.
(Calc a, Proposition a, SymVal t, EqSymbolic (SBV t)) =>
SMTConfig -> String -> a -> StepArgs a t -> TP (Proof a)
calcWith          SMTConfig
cfg                   String
nm a
p StepArgs a t
steps
  calcWith SMTConfig
cfg String
nm a
p StepArgs a t
steps = TP SMTConfig
getTPConfig TP SMTConfig -> (SMTConfig -> TP (Proof a)) -> TP (Proof a)
forall a b. TP a -> (a -> TP b) -> TP b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SMTConfig
cfg' -> Bool -> SMTConfig -> String -> a -> StepArgs a t -> TP (Proof a)
forall t.
(SymVal t, EqSymbolic (SBV t), Proposition a) =>
Bool -> SMTConfig -> String -> a -> StepArgs a t -> TP (Proof a)
forall a t.
(Calc a, SymVal t, EqSymbolic (SBV t), Proposition a) =>
Bool -> SMTConfig -> String -> a -> StepArgs a t -> TP (Proof a)
calcGeneric Bool
False (SMTConfig -> SMTConfig -> SMTConfig
tpMergeCfg SMTConfig
cfg SMTConfig
cfg') String
nm a
p StepArgs a t
steps

  calcGeneric :: (SymVal t, EqSymbolic (SBV t), Proposition a) => Bool -> SMTConfig -> String -> a -> StepArgs a t -> TP (Proof a)
  calcGeneric Bool
tagTheorem SMTConfig
cfg String
nm a
result StepArgs a t
steps = String -> TP (Proof a) -> TP (Proof a)
forall a. Typeable a => String -> TP (Proof a) -> TP (Proof a)
withProofCache String
nm (TP (Proof a) -> TP (Proof a)) -> TP (Proof a) -> TP (Proof a)
forall a b. (a -> b) -> a -> b
$ do
      TPState
tpSt <- TP TPState
getTPState
      TPUnique
u    <- TP TPUnique
tpGetNextUnique

      (SBool
_, CalcStrategy {[Int] -> Symbolic SBool
calcQCInstance :: CalcStrategy -> [Int] -> Symbolic SBool
calcQCInstance :: [Int] -> Symbolic SBool
calcQCInstance}) <- IO (SBool, CalcStrategy) -> TP (SBool, CalcStrategy)
forall a. IO a -> TP a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SBool, CalcStrategy) -> TP (SBool, CalcStrategy))
-> IO (SBool, CalcStrategy) -> TP (SBool, CalcStrategy)
forall a b. (a -> b) -> a -> b
$ SMTConfig
-> Symbolic (SBool, CalcStrategy) -> IO (SBool, CalcStrategy)
forall a. SMTConfig -> Symbolic a -> IO a
runSMTWith SMTConfig
cfg (a -> StepArgs a t -> Symbolic (SBool, CalcStrategy)
forall t.
(SymVal t, EqSymbolic (SBV t)) =>
a -> StepArgs a t -> Symbolic (SBool, CalcStrategy)
forall a t.
(Calc a, SymVal t, EqSymbolic (SBV t)) =>
a -> StepArgs a t -> Symbolic (SBool, CalcStrategy)
calcSteps a
result StepArgs a t
steps)

      IO (Proof a) -> TP (Proof a)
forall a. IO a -> TP a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Proof a) -> TP (Proof a)) -> IO (Proof a) -> TP (Proof a)
forall a b. (a -> b) -> a -> b
$ SMTConfig -> Symbolic (Proof a) -> IO (Proof a)
forall a. SMTConfig -> Symbolic a -> IO a
runSMTWith SMTConfig
cfg (Symbolic (Proof a) -> IO (Proof a))
-> Symbolic (Proof a) -> IO (Proof a)
forall a b. (a -> b) -> a -> b
$ do

         a -> SymbolicT IO ()
forall (m :: * -> *) a.
(Monad m, MonadIO m, SolverContext m, QSaturate m a) =>
a -> m ()
qSaturateSavingObservables a
result -- make sure we saturate the result, i.e., get all it's UI's, types etc. pop out

         SMTConfig -> String -> SymbolicT IO ()
forall (m :: * -> *). MonadIO m => SMTConfig -> String -> m ()
message SMTConfig
cfg (String -> SymbolicT IO ()) -> String -> SymbolicT IO ()
forall a b. (a -> b) -> a -> b
$ (if Bool
tagTheorem then String
"Theorem" else String
"Lemma") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

         (SBool
calcGoal, strategy :: CalcStrategy
strategy@CalcStrategy {SBool
calcIntros :: CalcStrategy -> SBool
calcIntros :: SBool
calcIntros, TPProof
calcProofTree :: CalcStrategy -> TPProof
calcProofTree :: TPProof
calcProofTree}) <- a -> StepArgs a t -> Symbolic (SBool, CalcStrategy)
forall t.
(SymVal t, EqSymbolic (SBV t)) =>
a -> StepArgs a t -> Symbolic (SBool, CalcStrategy)
forall a t.
(Calc a, SymVal t, EqSymbolic (SBV t)) =>
a -> StepArgs a t -> Symbolic (SBool, CalcStrategy)
calcSteps a
result StepArgs a t
steps

         -- Collect all subterms and saturate them
         (SBool -> SymbolicT IO ()) -> [SBool] -> SymbolicT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SBool -> SymbolicT IO ()
forall (m :: * -> *) a.
(Monad m, MonadIO m, SolverContext m, QSaturate m a) =>
a -> m ()
qSaturateSavingObservables ([SBool] -> SymbolicT IO ()) -> [SBool] -> SymbolicT IO ()
forall a b. (a -> b) -> a -> b
$ CalcStrategy -> [SBool]
getCalcStrategySaturatables CalcStrategy
strategy

         Query (Proof a) -> Symbolic (Proof a)
forall a. Query a -> Symbolic a
query (Query (Proof a) -> Symbolic (Proof a))
-> Query (Proof a) -> Symbolic (Proof a)
forall a b. (a -> b) -> a -> b
$ SMTConfig
-> TPState
-> String
-> (a, SBool)
-> SBool
-> TPProof
-> TPUnique
-> ([Int] -> Symbolic SBool)
-> Query (Proof a)
forall a.
Proposition a =>
SMTConfig
-> TPState
-> String
-> (a, SBool)
-> SBool
-> TPProof
-> TPUnique
-> ([Int] -> Symbolic SBool)
-> Query (Proof a)
proveProofTree SMTConfig
cfg TPState
tpSt String
nm (a
result, SBool
calcGoal) SBool
calcIntros TPProof
calcProofTree TPUnique
u [Int] -> Symbolic SBool
calcQCInstance

-- | In the proof tree, what's the next node label?
nextProofStep :: [Int] -> [Int]
nextProofStep :: [Int] -> [Int]
nextProofStep [Int]
bs = case [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
bs of
                     Int
i : [Int]
rs -> [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
rs
                     []     -> [Int
1]

-- | Prove the proof tree. The arguments are:
--
--      result           : The ultimate goal we want to prove. Note that this is a general proposition, and we don't actually prove it. See the next param.
--      resultBool       : The instance of result that, if we prove it, establishes the result itself
--      initialHypotheses: Hypotheses (conjuncted)
--      calcProofTree    : A tree of steps, which give rise to a bunch of equalities
--
-- Note that we do not check the resultBool is the result itself just "instantiated" appropriately. This is the contract with the caller who
-- has to establish that by whatever means it chooses to do so.
--
-- The final proof we have has the following form:
--
--     - For each "link" in the proofTree, prove that intros .=> link
--     - The above will give us a bunch of results, for each leaf node in the tree.
--     - Then prove: (intros .=> sAnd results) .=> resultBool
--     - Then conclude result, based on what assumption that proving resultBool establishes result
--
-- NB. This function needs to be in "sync" with qcRun below for obvious reasons. So, any changes there
-- make it here too!
proveProofTree :: Proposition a
               => SMTConfig
               -> TPState
               -> String                    -- ^ the name of the top result
               -> (a, SBool)                -- ^ goal: as a proposition and as a boolean
               -> SBool                     -- ^ hypotheses
               -> TPProof                   -- ^ proof tree
               -> TPUnique                  -- ^ unique id
               -> ([Int] -> Symbolic SBool) -- ^ quick-checker
               -> Query (Proof a)
proveProofTree :: forall a.
Proposition a =>
SMTConfig
-> TPState
-> String
-> (a, SBool)
-> SBool
-> TPProof
-> TPUnique
-> ([Int] -> Symbolic SBool)
-> Query (Proof a)
proveProofTree SMTConfig
cfg TPState
tpSt String
nm (a
result, SBool
resultBool) SBool
initialHypotheses TPProof
calcProofTree TPUnique
uniq [Int] -> Symbolic SBool
quickCheckInstance = do
    [SBool]
results <- SBool -> Int -> ([Int], TPProof) -> Query [SBool]
walk SBool
initialHypotheses Int
1 ([Int
1], TPProof
calcProofTree)

    [String] -> Query ()
queryDebug [String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Proof end: proving the result:"]

    Maybe UTCTime
mbStartTime <- Bool -> QueryT IO (Maybe UTCTime)
forall (m :: * -> *). MonadIO m => Bool -> m (Maybe UTCTime)
getTimeStampIf Bool
printStats
    SMTConfig
-> TPState
-> String
-> Int
-> TPProofContext
-> Maybe SBool
-> SBool
-> [(String, SVal)]
-> ((Int, Maybe NominalDiffTime) -> IO (Proof a))
-> Query (Proof a)
forall (m :: * -> *) a r.
(SolverContext m, MonadIO m, MonadQuery m, MonadSymbolic m,
 Proposition a) =>
SMTConfig
-> TPState
-> String
-> Int
-> TPProofContext
-> Maybe SBool
-> a
-> [(String, SVal)]
-> ((Int, Maybe NominalDiffTime) -> IO r)
-> m r
smtProofStep SMTConfig
cfg TPState
tpSt String
"Result" Int
1
                 (Bool -> String -> [String] -> [String] -> TPProofContext
TPProofStep Bool
False String
nm [] [String
""])
                 (SBool -> Maybe SBool
forall a. a -> Maybe a
Just (SBool
initialHypotheses SBool -> SBool -> SBool
.=> [SBool] -> SBool
sAnd [SBool]
results))
                 SBool
resultBool [] (((Int, Maybe NominalDiffTime) -> IO (Proof a)) -> Query (Proof a))
-> ((Int, Maybe NominalDiffTime) -> IO (Proof a))
-> Query (Proof a)
forall a b. (a -> b) -> a -> b
$ \(Int, Maybe NominalDiffTime)
d ->
                   do Maybe NominalDiffTime
mbElapsed <- Maybe UTCTime -> IO (Maybe NominalDiffTime)
forall (m :: * -> *).
MonadIO m =>
Maybe UTCTime -> m (Maybe NominalDiffTime)
getElapsedTime Maybe UTCTime
mbStartTime
                      let modulo :: String
modulo = [ProofObj] -> String
concludeModulo ((Helper -> [ProofObj]) -> [Helper] -> [ProofObj]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Helper -> [ProofObj]
getHelperProofs (TPProof -> [Helper]
getAllHelpers TPProof
calcProofTree))
                      SMTConfig
-> String
-> (Int, Maybe NominalDiffTime)
-> [NominalDiffTime]
-> IO ()
finishTP SMTConfig
cfg (String
"Q.E.D." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
modulo) (Int, Maybe NominalDiffTime)
d ([Maybe NominalDiffTime] -> [NominalDiffTime]
forall a. [Maybe a] -> [a]
catMaybes [Maybe NominalDiffTime
mbElapsed])

                      Proof a -> IO (Proof a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proof a -> IO (Proof a)) -> Proof a -> IO (Proof a)
forall a b. (a -> b) -> a -> b
$ ProofObj -> Proof a
forall a. ProofObj -> Proof a
Proof (ProofObj -> Proof a) -> ProofObj -> Proof a
forall a b. (a -> b) -> a -> b
$ ProofObj { dependencies :: [ProofObj]
dependencies = TPProof -> [ProofObj]
getDependencies TPProof
calcProofTree
                                              , isUserAxiom :: Bool
isUserAxiom  = Bool
False
                                              , getObjProof :: SBool
getObjProof  = String -> SBool -> SBool
forall a. SymVal a => String -> SBV a -> SBV a
label String
nm (a -> SBool
forall a. QuantifiedBool a => a -> SBool
quantifiedBool a
result)
                                              , getProp :: Dynamic
getProp      = a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn a
result
                                              , proofName :: String
proofName    = String
nm
                                              , uniqId :: TPUnique
uniqId       = TPUnique
uniq
                                              , isCached :: Bool
isCached     = Bool
False
                                              }

  where SMTConfig{tpOptions :: SMTConfig -> TPOptions
tpOptions = TPOptions{Bool
printStats :: Bool
printStats :: TPOptions -> Bool
printStats}} = SMTConfig
cfg

        isEnd :: TPProofGen a bh b -> Bool
isEnd ProofEnd{}    = Bool
True
        isEnd ProofStep{}   = Bool
False
        isEnd ProofBranch{} = Bool
False

        -- trim the branch-name, if we're in a deeper level, and we're at the end
        trimBN :: a -> [a] -> [a]
trimBN a
level [a]
bn | a
level a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1, a
1 : [a]
_ <- [a] -> [a]
forall a. [a] -> [a]
reverse [a]
bn = [a] -> [a]
forall a. HasCallStack => [a] -> [a]
init [a]
bn
                        | Bool
True                           = [a]
bn

        -- If the next step is ending and we're the 1st step; our number can be skipped
        mkStepName :: a -> [a] -> TPProofGen a bh b -> [String]
mkStepName a
level [a]
bn TPProofGen a bh b
nextStep | TPProofGen a bh b -> Bool
forall {a} {bh} {b}. TPProofGen a bh b -> Bool
isEnd TPProofGen a bh b
nextStep = (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show (a -> [a] -> [a]
forall {a} {a}. (Ord a, Num a, Num a, Eq a) => a -> [a] -> [a]
trimBN a
level [a]
bn)
                                     | Bool
True           = (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
bn

        walk :: SBool -> Int -> ([Int], TPProof) -> Query [SBool]

        -- End of proof, return what it established. If there's a hint associated here, it was probably by mistake; so tell it to the user.
        walk :: SBool -> Int -> ([Int], TPProof) -> Query [SBool]
walk SBool
intros Int
level ([Int]
bn, ProofEnd SBool
calcResult [Helper]
hs)
           | Bool -> Bool
not ([Helper] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Helper]
hs)
           = String -> Query [SBool]
forall a. HasCallStack => String -> a
error (String -> Query [SBool]) -> String -> Query [SBool]
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
""
                             , String
"*** Incorrect calc/induct lemma calculations."
                             , String
"***"
                             , String
"***    The last step in the proof has a helper, which isn't used."
                             , String
"***"
                             , String
"*** Perhaps the hint is off-by-one in its placement?"
                             ]
           | Bool
True
           =  do -- If we're not at the top-level and this is the only step, print it.
                 -- Otherwise the noise isn't necessary.
                 Bool -> Query () -> Query ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Query () -> Query ()) -> Query () -> Query ()
forall a b. (a -> b) -> a -> b
$ case [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
bn of
                                      Int
1 : [Int]
_ -> IO () -> Query ()
forall a. IO a -> QueryT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Query ()) -> IO () -> Query ()
forall a b. (a -> b) -> a -> b
$ do Int
tab <- SMTConfig -> Bool -> String -> Int -> TPProofContext -> IO Int
startTP SMTConfig
cfg Bool
False String
"Step" Int
level (Bool -> String -> [String] -> [String] -> TPProofContext
TPProofStep Bool
False String
nm [] ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show ([Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
init [Int]
bn)))
                                                           SMTConfig
-> String
-> (Int, Maybe NominalDiffTime)
-> [NominalDiffTime]
-> IO ()
finishTP SMTConfig
cfg String
"Q.E.D." (Int
tab, Maybe NominalDiffTime
forall a. Maybe a
Nothing) []
                                      [Int]
_     -> () -> Query ()
forall a. a -> QueryT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

                 [SBool] -> Query [SBool]
forall a. a -> QueryT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [SBool
intros SBool -> SBool -> SBool
.=> SBool
calcResult]

        -- Do the branches separately and collect the results. If there's coverage needed, we do it too; which
        -- is essentially the assumption here.
        walk SBool
intros Int
level ([Int]
bnTop, ProofBranch Bool
checkCompleteness [String]
hintStrings [(SBool, TPProof)]
ps) = do

          let bn :: [Int]
bn = Int -> [Int] -> [Int]
forall {a} {a}. (Ord a, Num a, Num a, Eq a) => a -> [a] -> [a]
trimBN Int
level [Int]
bnTop

              addSuffix :: [[a]] -> [a] -> [[a]]
addSuffix [[a]]
xs [a]
s = case [[a]] -> [[a]]
forall a. [a] -> [a]
reverse [[a]]
xs of
                                  [a]
l : [[a]]
p -> [[a]] -> [[a]]
forall a. [a] -> [a]
reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ ([a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
s) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
p
                                  []    -> [[a]
s]

              full :: String
full | Bool
checkCompleteness = String
""
                   | Bool
True              = String
"full "

              stepName :: [String]
stepName = (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [Int]
bn

          Int
_ <- IO Int -> Query Int
forall a. IO a -> QueryT IO a
io (IO Int -> Query Int) -> IO Int -> Query Int
forall a b. (a -> b) -> a -> b
$ SMTConfig -> Bool -> String -> Int -> TPProofContext -> IO Int
startTP SMTConfig
cfg Bool
True String
"Step" Int
level (Bool -> String -> [String] -> [String] -> TPProofContext
TPProofStep Bool
False String
nm [String]
hintStrings ([String] -> String -> [String]
forall {a}. [[a]] -> [a] -> [[a]]
addSuffix [String]
stepName (String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([(SBool, TPProof)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(SBool, TPProof)]
ps) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" way " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
full String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"case split)")))

          [SBool]
results <- [[SBool]] -> [SBool]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[SBool]] -> [SBool]) -> QueryT IO [[SBool]] -> Query [SBool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Query [SBool]] -> QueryT IO [[SBool]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [SBool -> Int -> ([Int], TPProof) -> Query [SBool]
walk (SBool
intros SBool -> SBool -> SBool
.&& SBool
branchCond) (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Int]
bn [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
i, Int
1], TPProof
p) | (Int
i, (SBool
branchCond, TPProof
p)) <- [Int] -> [(SBool, TPProof)] -> [(Int, (SBool, TPProof))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [(SBool, TPProof)]
ps]

          Bool -> Query () -> Query ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
checkCompleteness (Query () -> Query ()) -> Query () -> Query ()
forall a b. (a -> b) -> a -> b
$ SMTConfig
-> TPState
-> String
-> Int
-> TPProofContext
-> Maybe SBool
-> SBool
-> [(String, SVal)]
-> ((Int, Maybe NominalDiffTime) -> IO ())
-> Query ()
forall (m :: * -> *) a r.
(SolverContext m, MonadIO m, MonadQuery m, MonadSymbolic m,
 Proposition a) =>
SMTConfig
-> TPState
-> String
-> Int
-> TPProofContext
-> Maybe SBool
-> a
-> [(String, SVal)]
-> ((Int, Maybe NominalDiffTime) -> IO r)
-> m r
smtProofStep SMTConfig
cfg TPState
tpSt String
"Step" (Int
levelInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                                                         (Bool -> String -> [String] -> [String] -> TPProofContext
TPProofStep Bool
False String
nm [] ([String]
stepName [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"Completeness"]))
                                                         (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
intros)
                                                         ([SBool] -> SBool
sOr (((SBool, TPProof) -> SBool) -> [(SBool, TPProof)] -> [SBool]
forall a b. (a -> b) -> [a] -> [b]
map (SBool, TPProof) -> SBool
forall a b. (a, b) -> a
fst [(SBool, TPProof)]
ps))
                                                         []
                                                         (\(Int, Maybe NominalDiffTime)
d -> SMTConfig
-> String
-> (Int, Maybe NominalDiffTime)
-> [NominalDiffTime]
-> IO ()
finishTP SMTConfig
cfg String
"Q.E.D." (Int, Maybe NominalDiffTime)
d [])
          [SBool] -> Query [SBool]
forall a. a -> QueryT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [SBool]
results

        -- Do a proof step
        walk SBool
intros Int
level ([Int]
bn, ProofStep SBool
cur [Helper]
hs TPProof
p) = do

             let finish :: [NominalDiffTime]
-> [ProofObj] -> (Int, Maybe NominalDiffTime) -> IO ()
finish [NominalDiffTime]
et [ProofObj]
helpers (Int, Maybe NominalDiffTime)
d = SMTConfig
-> String
-> (Int, Maybe NominalDiffTime)
-> [NominalDiffTime]
-> IO ()
finishTP SMTConfig
cfg (String
"Q.E.D." String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ProofObj] -> String
concludeModulo [ProofObj]
helpers) (Int, Maybe NominalDiffTime)
d [NominalDiffTime]
et
                 stepName :: [String]
stepName            = Int -> [Int] -> TPProof -> [String]
forall {a} {a} {a} {bh} {b}.
(Show a, Ord a, Num a, Num a, Eq a) =>
a -> [a] -> TPProofGen a bh b -> [String]
mkStepName Int
level [Int]
bn TPProof
p
                 disps :: [(String, SVal)]
disps               = [(String
n, SVal
v) | HelperDisp String
n SVal
v <- [Helper]
hs]

                 -- First prove the assumptions, if there are any. We stay quiet, unless timing is asked for
                 (SMTConfig
quietCfg, (Int, Maybe NominalDiffTime) -> IO ()
finalizer)
                   | Bool
printStats = (SMTConfig
cfg,                                             [NominalDiffTime]
-> [ProofObj] -> (Int, Maybe NominalDiffTime) -> IO ()
finish [] [])
                   | Bool
True       = (SMTConfig
cfg{tpOptions = (tpOptions cfg) {quiet = True}}, IO () -> (Int, Maybe NominalDiffTime) -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))

                 as :: [SBool]
as = (Helper -> [SBool]) -> [Helper] -> [SBool]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Helper -> [SBool]
getHelperAssumes [Helper]
hs
                 ss :: [String]
ss = [Helper] -> [String]
getHelperText [Helper]
hs

             case [SBool]
as of
               [] -> () -> Query ()
forall a. a -> QueryT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
               [SBool]
_  -> SMTConfig
-> TPState
-> String
-> Int
-> TPProofContext
-> Maybe SBool
-> SBool
-> [(String, SVal)]
-> ((Int, Maybe NominalDiffTime) -> IO ())
-> Query ()
forall (m :: * -> *) a r.
(SolverContext m, MonadIO m, MonadQuery m, MonadSymbolic m,
 Proposition a) =>
SMTConfig
-> TPState
-> String
-> Int
-> TPProofContext
-> Maybe SBool
-> a
-> [(String, SVal)]
-> ((Int, Maybe NominalDiffTime) -> IO r)
-> m r
smtProofStep SMTConfig
quietCfg TPState
tpSt String
"Asms" Int
level
                                           (Bool -> String -> [String] -> [String] -> TPProofContext
TPProofStep Bool
True String
nm [] [String]
stepName)
                                           (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
intros)
                                           ([SBool] -> SBool
sAnd [SBool]
as)
                                           [(String, SVal)]
disps
                                           (Int, Maybe NominalDiffTime) -> IO ()
finalizer

             -- Are we asked to do quick-check?
             case [Args
qcArg | HelperQC Args
qcArg <- [Helper]
hs] of
               [] -> do -- No quickcheck. Just prove the step
                        let by :: [ProofObj]
by = (Helper -> [ProofObj]) -> [Helper] -> [ProofObj]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Helper -> [ProofObj]
getHelperProofs [Helper]
hs

                        SMTConfig
-> TPState
-> String
-> Int
-> TPProofContext
-> Maybe SBool
-> SBool
-> [(String, SVal)]
-> ((Int, Maybe NominalDiffTime) -> IO ())
-> Query ()
forall (m :: * -> *) a r.
(SolverContext m, MonadIO m, MonadQuery m, MonadSymbolic m,
 Proposition a) =>
SMTConfig
-> TPState
-> String
-> Int
-> TPProofContext
-> Maybe SBool
-> a
-> [(String, SVal)]
-> ((Int, Maybe NominalDiffTime) -> IO r)
-> m r
smtProofStep SMTConfig
cfg TPState
tpSt String
"Step" Int
level
                                         (Bool -> String -> [String] -> [String] -> TPProofContext
TPProofStep Bool
False String
nm [String]
ss [String]
stepName)
                                         (SBool -> Maybe SBool
forall a. a -> Maybe a
Just ([SBool] -> SBool
sAnd (SBool
intros SBool -> [SBool] -> [SBool]
forall a. a -> [a] -> [a]
: [SBool]
as [SBool] -> [SBool] -> [SBool]
forall a. [a] -> [a] -> [a]
++ (ProofObj -> SBool) -> [ProofObj] -> [SBool]
forall a b. (a -> b) -> [a] -> [b]
map ProofObj -> SBool
getObjProof [ProofObj]
by)))
                                         SBool
cur
                                         [(String, SVal)]
disps
                                         ([NominalDiffTime]
-> [ProofObj] -> (Int, Maybe NominalDiffTime) -> IO ()
finish [] [ProofObj]
by)

               [Args]
xs -> do let qcArg :: Args
qcArg = [Args] -> Args
forall a. HasCallStack => [a] -> a
last [Args]
xs -- take the last one if multiple exists. Why not?

                            hs' :: [Helper]
hs' = (Helper -> [Helper]) -> [Helper] -> [Helper]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Helper -> [Helper]
xform [Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [String -> Helper
HelperString (String
"qc: Running " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Args -> Int
QC.maxSuccess Args
qcArg) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" tests")]
                            xform :: Helper -> [Helper]
xform HelperProof{}    = []
                            xform HelperAssum{}    = []
                            xform h :: Helper
h@HelperQC{}     = [Helper
h]
                            xform h :: Helper
h@HelperString{} = [Helper
h]
                            xform HelperDisp{}     = []

                        IO () -> Query ()
forall a. IO a -> QueryT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Query ()) -> IO () -> Query ()
forall a b. (a -> b) -> a -> b
$ do

                           Int
tab <- SMTConfig -> Bool -> String -> Int -> TPProofContext -> IO Int
startTP SMTConfig
cfg (SMTConfig -> Bool
verbose SMTConfig
cfg) String
"Step" Int
level (Bool -> String -> [String] -> [String] -> TPProofContext
TPProofStep Bool
False String
nm ([Helper] -> [String]
getHelperText [Helper]
hs') [String]
stepName)

                           (Maybe NominalDiffTime
mbT, Result
r) <- Bool -> IO Result -> IO (Maybe NominalDiffTime, Result)
forall (m :: * -> *) a.
MonadIO m =>
Bool -> m a -> m (Maybe NominalDiffTime, a)
timeIf Bool
printStats (IO Result -> IO (Maybe NominalDiffTime, Result))
-> IO Result -> IO (Maybe NominalDiffTime, Result)
forall a b. (a -> b) -> a -> b
$ Args -> Symbolic SBool -> IO Result
forall prop. Testable prop => Args -> prop -> IO Result
quickCheckWithResult Args
qcArg{QC.chatty = verbose cfg} (Symbolic SBool -> IO Result) -> Symbolic SBool -> IO Result
forall a b. (a -> b) -> a -> b
$ [Int] -> Symbolic SBool
quickCheckInstance [Int]
bn

                           case Maybe NominalDiffTime
mbT of
                             Maybe NominalDiffTime
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                             Just NominalDiffTime
t  -> TPState -> (TPStats -> TPStats) -> IO ()
forall (m :: * -> *).
MonadIO m =>
TPState -> (TPStats -> TPStats) -> m ()
updStats TPState
tpSt (\TPStats
s -> TPStats
s{qcElapsed = qcElapsed s + t})

                           let err :: Maybe String
err = case Result
r of
                                   QC.Success {}                -> Maybe String
forall a. Maybe a
Nothing
                                   QC.Failure {output :: Result -> String
QC.output = String
out} -> String -> Maybe String
forall a. a -> Maybe a
Just String
out
                                   QC.GaveUp  {}                -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
"*** QuickCheck reported \"GaveUp\""
                                                                                  , String
"***"
                                                                                  , String
"*** This can happen if you have assumptions in the environment"
                                                                                  , String
"*** that makes it hard for quick-check to generate valid test values."
                                                                                  , String
"***"
                                                                                  , String
"*** See if you can reduce assumptions. If not, please get in touch,"
                                                                                  , String
"*** to see if we can handle the problem via custom Arbitrary instances."
                                                                                  ]
                                   QC.NoExpectedFailure {}      -> String -> Maybe String
forall a. a -> Maybe a
Just String
"Expected failure but test passed." -- can't happen

                           case Maybe String
err of
                             Just String
e  -> do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\n*** QuickCheck failed for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." (String
nm String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
stepName)
                                           String -> IO ()
putStrLn String
e
                                           String -> IO ()
forall a. HasCallStack => String -> a
error String
"Failed"

                             Maybe String
Nothing -> let extra :: String
extra = [Char
' ' | Bool
printStats]  -- aligns better when printing stats
                                        in SMTConfig
-> String
-> (Int, Maybe NominalDiffTime)
-> [NominalDiffTime]
-> IO ()
finishTP SMTConfig
cfg (String
"QC OK" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
extra) (Int
tab, Maybe NominalDiffTime
mbT) []

             -- Move to next
             SBool -> Int -> ([Int], TPProof) -> Query [SBool]
walk SBool
intros Int
level ([Int] -> [Int]
nextProofStep [Int]
bn, TPProof
p)

-- | Helper data-type for calc-step below
data CalcContext a = CalcStart     [Helper] -- Haven't started yet
                   | CalcStep  a a [Helper] -- Intermediate step: first value, prev value


-- | Turn a raw (i.e., as written by the user) proof tree to a tree where the successive equalities are made explicit.
mkProofTree :: SymVal a => (SBV a -> SBV a -> c, SBV a -> SBV a -> SBool) -> TPProofRaw (SBV a) -> TPProofGen c [String] SBool
mkProofTree :: forall a c.
SymVal a =>
(SBV a -> SBV a -> c, SBV a -> SBV a -> SBool)
-> TPProofRaw (SBV a) -> TPProofGen c [String] SBool
mkProofTree (SBV a -> SBV a -> c
symTraceEq, SBV a -> SBV a -> SBool
symEq) = CalcContext (SBV a)
-> TPProofGen (SBV a) [Helper] () -> TPProofGen c [String] SBool
go ([Helper] -> CalcContext (SBV a)
forall a. [Helper] -> CalcContext a
CalcStart [])
  where -- End of the proof; tie the begin and end
        go :: CalcContext (SBV a)
-> TPProofGen (SBV a) [Helper] () -> TPProofGen c [String] SBool
go CalcContext (SBV a)
step (ProofEnd () [Helper]
hs) = case CalcContext (SBV a)
step of
                                     -- It's tempting to error out if we're at the start and already reached the end
                                     -- This means we're given a sequence of no-steps. While this is useless in the
                                     -- general case, it's quite valid in a case-split; where one of the case-splits
                                     -- might be easy enough for the solver to deduce so the user simply says "just derive it for me."
                                     CalcStart [Helper]
hs'           -> SBool -> [Helper] -> TPProofGen c [String] SBool
forall a bh b. b -> [Helper] -> TPProofGen a bh b
ProofEnd SBool
sTrue ([Helper]
hs' [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [Helper]
hs) -- Nothing proven!
                                     CalcStep  SBV a
begin SBV a
end [Helper]
hs' -> SBool -> [Helper] -> TPProofGen c [String] SBool
forall a bh b. b -> [Helper] -> TPProofGen a bh b
ProofEnd (SBV a
begin SBV a -> SBV a -> SBool
`symEq` SBV a
end) ([Helper]
hs' [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [Helper]
hs)

        -- Branch: Just push it down. We use the hints from previous step, and pass the current ones down.
        go CalcContext (SBV a)
step (ProofBranch Bool
c [Helper]
hs [(SBool, TPProofGen (SBV a) [Helper] ())]
ps) = Bool
-> [String]
-> [(SBool, TPProofGen c [String] SBool)]
-> TPProofGen c [String] SBool
forall a bh b.
Bool -> bh -> [(SBool, TPProofGen a bh b)] -> TPProofGen a bh b
ProofBranch Bool
c ([Helper] -> [String]
getHelperText [Helper]
hs) [(SBool
bc, CalcContext (SBV a)
-> TPProofGen (SBV a) [Helper] () -> TPProofGen c [String] SBool
go CalcContext (SBV a)
step' TPProofGen (SBV a) [Helper] ()
p) | (SBool
bc, TPProofGen (SBV a) [Helper] ()
p) <- [(SBool, TPProofGen (SBV a) [Helper] ())]
ps]
           where step' :: CalcContext (SBV a)
step' = case CalcContext (SBV a)
step of
                           CalcStart [Helper]
hs'     -> [Helper] -> CalcContext (SBV a)
forall a. [Helper] -> CalcContext a
CalcStart ([Helper]
hs' [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [Helper]
hs)
                           CalcStep  SBV a
a SBV a
b [Helper]
hs' -> SBV a -> SBV a -> [Helper] -> CalcContext (SBV a)
forall a. a -> a -> [Helper] -> CalcContext a
CalcStep SBV a
a SBV a
b ([Helper]
hs' [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [Helper]
hs)

        -- Step:
        go (CalcStart [Helper]
hs)           (ProofStep SBV a
cur [Helper]
hs' TPProofGen (SBV a) [Helper] ()
p) = CalcContext (SBV a)
-> TPProofGen (SBV a) [Helper] () -> TPProofGen c [String] SBool
go (SBV a -> SBV a -> [Helper] -> CalcContext (SBV a)
forall a. a -> a -> [Helper] -> CalcContext a
CalcStep SBV a
cur SBV a
cur ([Helper]
hs' [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [Helper]
hs)) TPProofGen (SBV a) [Helper] ()
p
        go (CalcStep SBV a
first SBV a
prev [Helper]
hs) (ProofStep SBV a
cur [Helper]
hs' TPProofGen (SBV a) [Helper] ()
p) = c
-> [Helper]
-> TPProofGen c [String] SBool
-> TPProofGen c [String] SBool
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep (SBV a
prev SBV a -> SBV a -> c
`symTraceEq` SBV a
cur) [Helper]
hs (CalcContext (SBV a)
-> TPProofGen (SBV a) [Helper] () -> TPProofGen c [String] SBool
go (SBV a -> SBV a -> [Helper] -> CalcContext (SBV a)
forall a. a -> a -> [Helper] -> CalcContext a
CalcStep SBV a
first SBV a
cur [Helper]
hs') TPProofGen (SBV a) [Helper] ()
p)

-- | Turn a sequence of steps into a chain of equalities
mkCalcSteps :: SymVal a => (SBool, TPProofRaw (SBV a)) -> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
mkCalcSteps :: forall a.
SymVal a =>
(SBool, TPProofRaw (SBV a))
-> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
mkCalcSteps (SBool
intros, TPProofRaw (SBV a)
tpp) [Int] -> Symbolic SBool
qcInstance = do
        CalcStrategy -> Symbolic CalcStrategy
forall a. a -> SymbolicT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CalcStrategy -> Symbolic CalcStrategy)
-> CalcStrategy -> Symbolic CalcStrategy
forall a b. (a -> b) -> a -> b
$ CalcStrategy { calcIntros :: SBool
calcIntros     = SBool
intros
                            , calcProofTree :: TPProof
calcProofTree  = (SBV a -> SBV a -> SBool, SBV a -> SBV a -> SBool)
-> TPProofRaw (SBV a) -> TPProof
forall a c.
SymVal a =>
(SBV a -> SBV a -> c, SBV a -> SBV a -> SBool)
-> TPProofRaw (SBV a) -> TPProofGen c [String] SBool
mkProofTree (SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
(.===), SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
(.===)) TPProofRaw (SBV a)
tpp
                            , calcQCInstance :: [Int] -> Symbolic SBool
calcQCInstance = [Int] -> Symbolic SBool
qcInstance
                            }

-- | Given initial hypothesis, and a raw proof tree, build the quick-check walk over this tree for the step that's marked as such.
qcRun :: SymVal a => [Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun :: forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel (SBool
intros, TPProofRaw (SBV a)
tpp) = do
        [([Int], (SBool, SBool))]
results <- SBool
-> Int
-> ([Int], TPProofGen (SBV a, SBV a, SBool) [String] SBool)
-> Symbolic [([Int], (SBool, SBool))]
forall a.
SymVal a =>
SBool
-> Int
-> ([Int], TPProofGen (SBV a, SBV a, SBool) [String] SBool)
-> Symbolic [([Int], (SBool, SBool))]
runTree SBool
sTrue Int
1 ([Int
1], (SBV a -> SBV a -> (SBV a, SBV a, SBool), SBV a -> SBV a -> SBool)
-> TPProofRaw (SBV a)
-> TPProofGen (SBV a, SBV a, SBool) [String] SBool
forall a c.
SymVal a =>
(SBV a -> SBV a -> c, SBV a -> SBV a -> SBool)
-> TPProofRaw (SBV a) -> TPProofGen c [String] SBool
mkProofTree (\SBV a
a SBV a
b -> (SBV a
a, SBV a
b, SBV a
a SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.=== SBV a
b), SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
(.==)) TPProofRaw (SBV a)
tpp)
        case [(SBool, SBool)
b | ([Int]
l, (SBool, SBool)
b) <- [([Int], (SBool, SBool))]
results, [Int]
l [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int]
checkedLabel] of
          [(SBool
caseCond, SBool
b)] -> do SBool -> SymbolicT IO ()
forall a. QuantifiedBool a => a -> SymbolicT IO ()
forall (m :: * -> *) a.
(SolverContext m, QuantifiedBool a) =>
a -> m ()
constrain (SBool -> SymbolicT IO ()) -> SBool -> SymbolicT IO ()
forall a b. (a -> b) -> a -> b
$ SBool
intros SBool -> SBool -> SBool
.&& SBool
caseCond
                                SBool -> Symbolic SBool
forall a. a -> SymbolicT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SBool
b
          []              -> Symbolic SBool
notFound
          [(SBool, SBool)]
_               -> String -> Symbolic SBool
die String
"Hit the label multiple times."

 where die :: String -> Symbolic SBool
die String
why =  String -> Symbolic SBool
forall a. HasCallStack => String -> a
error (String -> Symbolic SBool) -> String -> Symbolic SBool
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
""
                                  , String
"*** Data.SBV.patch: Impossible happened."
                                  , String
"***"
                                  , String
"*** " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
why
                                  , String
"***"
                                  , String
"*** While trying to quickcheck at level " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int]
checkedLabel
                                  , String
"*** Please report this as a bug!"
                                  ]

       -- It is possible that we may not find the node. Why? Because it might be under a case-split (ite essentially)
       -- and the random choices we made before-hand may just not get us there. Sigh. So, the right thing to do is
       -- to just say "we're good." But this can also indicate a bug in our code. Oh well, we'll ignore it.
       notFound :: Symbolic SBool
notFound = SBool -> Symbolic SBool
forall a. a -> SymbolicT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SBool
sTrue

       -- "run" the tree, and if we hit the correct label return the result.
       -- This needs to be in "sync" with proveProofTree for obvious reasons. So, any changes there
       -- make it here too!
       runTree :: SymVal a => SBool -> Int -> ([Int], TPProofGen (SBV a, SBV a, SBool) [String] SBool) -> Symbolic [([Int], (SBool, SBool))]
       runTree :: forall a.
SymVal a =>
SBool
-> Int
-> ([Int], TPProofGen (SBV a, SBV a, SBool) [String] SBool)
-> Symbolic [([Int], (SBool, SBool))]
runTree SBool
_        Int
_     ([Int]
_,  ProofEnd{})         = [([Int], (SBool, SBool))] -> Symbolic [([Int], (SBool, SBool))]
forall a. a -> SymbolicT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
       runTree SBool
caseCond Int
level ([Int]
bn, ProofBranch Bool
_ [String]
_ [(SBool, TPProofGen (SBV a, SBV a, SBool) [String] SBool)]
ps) = [[([Int], (SBool, SBool))]] -> [([Int], (SBool, SBool))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[([Int], (SBool, SBool))]] -> [([Int], (SBool, SBool))])
-> SymbolicT IO [[([Int], (SBool, SBool))]]
-> Symbolic [([Int], (SBool, SBool))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbolic [([Int], (SBool, SBool))]]
-> SymbolicT IO [[([Int], (SBool, SBool))]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [SBool
-> Int
-> ([Int], TPProofGen (SBV a, SBV a, SBool) [String] SBool)
-> Symbolic [([Int], (SBool, SBool))]
forall a.
SymVal a =>
SBool
-> Int
-> ([Int], TPProofGen (SBV a, SBV a, SBool) [String] SBool)
-> Symbolic [([Int], (SBool, SBool))]
runTree (SBool
caseCond SBool -> SBool -> SBool
.&& SBool
branchCond) (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Int]
bn [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
i, Int
1], TPProofGen (SBV a, SBV a, SBool) [String] SBool
p)
                                                                             | (Int
i, (SBool
branchCond, TPProofGen (SBV a, SBV a, SBool) [String] SBool
p)) <- [Int]
-> [(SBool, TPProofGen (SBV a, SBV a, SBool) [String] SBool)]
-> [(Int,
     (SBool, TPProofGen (SBV a, SBV a, SBool) [String] SBool))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [(SBool, TPProofGen (SBV a, SBV a, SBool) [String] SBool)]
ps
                                                                             ]
       runTree SBool
caseCond Int
level ([Int]
bn, ProofStep (SBV a
lhs, SBV a
rhs, SBool
cur) [Helper]
hs TPProofGen (SBV a, SBV a, SBool) [String] SBool
p) = do [([Int], (SBool, SBool))]
rest <- SBool
-> Int
-> ([Int], TPProofGen (SBV a, SBV a, SBool) [String] SBool)
-> Symbolic [([Int], (SBool, SBool))]
forall a.
SymVal a =>
SBool
-> Int
-> ([Int], TPProofGen (SBV a, SBV a, SBool) [String] SBool)
-> Symbolic [([Int], (SBool, SBool))]
runTree SBool
caseCond Int
level ([Int] -> [Int]
nextProofStep [Int]
bn, TPProofGen (SBV a, SBV a, SBool) [String] SBool
p)
                                                                        Bool -> SymbolicT IO () -> SymbolicT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Int]
bn [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int]
checkedLabel) (SymbolicT IO () -> SymbolicT IO ())
-> SymbolicT IO () -> SymbolicT IO ()
forall a b. (a -> b) -> a -> b
$ do
                                                                                String -> SBV a -> SymbolicT IO ()
forall a. SymVal a => String -> SBV a -> SymbolicT IO ()
sObserve String
"lhs" SBV a
lhs
                                                                                String -> SBV a -> SymbolicT IO ()
forall a. SymVal a => String -> SBV a -> SymbolicT IO ()
sObserve String
"rhs" SBV a
rhs
                                                                                ((String, SVal) -> SymbolicT IO ())
-> [(String, SVal)] -> SymbolicT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((String -> SVal -> SymbolicT IO ())
-> (String, SVal) -> SymbolicT IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> SVal -> SymbolicT IO ()
forall (m :: * -> *). MonadSymbolic m => String -> SVal -> m ()
S.sObserve) [(String
n, SVal
v) | HelperDisp String
n SVal
v <- [Helper]
hs]
                                                                        [([Int], (SBool, SBool))] -> Symbolic [([Int], (SBool, SBool))]
forall a. a -> SymbolicT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([([Int], (SBool, SBool))] -> Symbolic [([Int], (SBool, SBool))])
-> [([Int], (SBool, SBool))] -> Symbolic [([Int], (SBool, SBool))]
forall a b. (a -> b) -> a -> b
$ ([Int]
bn, (SBool
caseCond, SBool
cur)) ([Int], (SBool, SBool))
-> [([Int], (SBool, SBool))] -> [([Int], (SBool, SBool))]
forall a. a -> [a] -> [a]
: [([Int], (SBool, SBool))]
rest

-- | Chaining lemmas that depend on no extra variables
instance Calc SBool where
   calcSteps :: forall t.
(SymVal t, EqSymbolic (SBV t)) =>
SBool -> StepArgs SBool t -> Symbolic (SBool, CalcStrategy)
calcSteps SBool
result StepArgs SBool t
steps = (SBool
result,) (CalcStrategy -> (SBool, CalcStrategy))
-> Symbolic CalcStrategy -> Symbolic (SBool, CalcStrategy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SBool, TPProofRaw (SBV t))
-> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
forall a.
SymVal a =>
(SBool, TPProofRaw (SBV a))
-> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
mkCalcSteps (SBool, TPProofRaw (SBV t))
StepArgs SBool t
steps ([Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
`qcRun` (SBool, TPProofRaw (SBV t))
StepArgs SBool t
steps)

-- | Chaining lemmas that depend on a single extra variable.
instance (KnownSymbol na, SymVal a) => Calc (Forall na a -> SBool) where
   calcSteps :: forall t.
(SymVal t, EqSymbolic (SBV t)) =>
(Forall na a -> SBool)
-> StepArgs (Forall na a -> SBool) t
-> Symbolic (SBool, CalcStrategy)
calcSteps Forall na a -> SBool
result StepArgs (Forall na a -> SBool) t
steps = do SBV a
a  <- String -> Symbolic (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy na -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na))
                               let q :: [Int] -> Symbolic SBool
q [Int]
checkedLabel = do SBV a
aa <- String -> Symbolic (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy na -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na))
                                                       [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel (StepArgs (Forall na a -> SBool) t
SBV a -> (SBool, TPProofRaw (SBV t))
steps SBV a
aa)
                               (Forall na a -> SBool
result (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a),) (CalcStrategy -> (SBool, CalcStrategy))
-> Symbolic CalcStrategy -> Symbolic (SBool, CalcStrategy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SBool, TPProofRaw (SBV t))
-> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
forall a.
SymVal a =>
(SBool, TPProofRaw (SBV a))
-> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
mkCalcSteps (StepArgs (Forall na a -> SBool) t
SBV a -> (SBool, TPProofRaw (SBV t))
steps SBV a
a) [Int] -> Symbolic SBool
q

-- | Chaining lemmas that depend on two extra variables.
instance (KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b) => Calc (Forall na a -> Forall nb b -> SBool) where
   calcSteps :: forall t.
(SymVal t, EqSymbolic (SBV t)) =>
(Forall na a -> Forall nb b -> SBool)
-> StepArgs (Forall na a -> Forall nb b -> SBool) t
-> Symbolic (SBool, CalcStrategy)
calcSteps Forall na a -> Forall nb b -> SBool
result StepArgs (Forall na a -> Forall nb b -> SBool) t
steps = do (SBV a
a, SBV b
b) <- (,) (SBV a -> SBV b -> (SBV a, SBV b))
-> SymbolicT IO (SBV a) -> SymbolicT IO (SBV b -> (SBV a, SBV b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy na -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)) SymbolicT IO (SBV b -> (SBV a, SBV b))
-> SymbolicT IO (SBV b) -> SymbolicT IO (SBV a, SBV b)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nb -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb))
                               let q :: [Int] -> Symbolic SBool
q [Int]
checkedLabel = do (SBV a
aa, SBV b
ab) <- (,) (SBV a -> SBV b -> (SBV a, SBV b))
-> SymbolicT IO (SBV a) -> SymbolicT IO (SBV b -> (SBV a, SBV b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy na -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)) SymbolicT IO (SBV b -> (SBV a, SBV b))
-> SymbolicT IO (SBV b) -> SymbolicT IO (SBV a, SBV b)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nb -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb))
                                                       [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel (StepArgs (Forall na a -> Forall nb b -> SBool) t
SBV a -> SBV b -> (SBool, TPProofRaw (SBV t))
steps SBV a
aa SBV b
ab)
                               (Forall na a -> Forall nb b -> SBool
result (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b),) (CalcStrategy -> (SBool, CalcStrategy))
-> Symbolic CalcStrategy -> Symbolic (SBool, CalcStrategy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SBool, TPProofRaw (SBV t))
-> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
forall a.
SymVal a =>
(SBool, TPProofRaw (SBV a))
-> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
mkCalcSteps (StepArgs (Forall na a -> Forall nb b -> SBool) t
SBV a -> SBV b -> (SBool, TPProofRaw (SBV t))
steps SBV a
a SBV b
b) [Int] -> Symbolic SBool
q

-- | Chaining lemmas that depend on three extra variables.
instance (KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b, KnownSymbol nc, SymVal c) => Calc (Forall na a -> Forall nb b -> Forall nc c -> SBool) where
   calcSteps :: forall t.
(SymVal t, EqSymbolic (SBV t)) =>
(Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> StepArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool) t
-> Symbolic (SBool, CalcStrategy)
calcSteps Forall na a -> Forall nb b -> Forall nc c -> SBool
result StepArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool) t
steps = do (SBV a
a, SBV b
b, SBV c
c) <- (,,) (SBV a -> SBV b -> SBV c -> (SBV a, SBV b, SBV c))
-> SymbolicT IO (SBV a)
-> SymbolicT IO (SBV b -> SBV c -> (SBV a, SBV b, SBV c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy na -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)) SymbolicT IO (SBV b -> SBV c -> (SBV a, SBV b, SBV c))
-> SymbolicT IO (SBV b)
-> SymbolicT IO (SBV c -> (SBV a, SBV b, SBV c))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nb -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)) SymbolicT IO (SBV c -> (SBV a, SBV b, SBV c))
-> SymbolicT IO (SBV c) -> SymbolicT IO (SBV a, SBV b, SBV c)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nc -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc))
                               let q :: [Int] -> Symbolic SBool
q [Int]
checkedLabel = do (SBV a
aa, SBV b
ab, SBV c
ac) <- (,,) (SBV a -> SBV b -> SBV c -> (SBV a, SBV b, SBV c))
-> SymbolicT IO (SBV a)
-> SymbolicT IO (SBV b -> SBV c -> (SBV a, SBV b, SBV c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy na -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)) SymbolicT IO (SBV b -> SBV c -> (SBV a, SBV b, SBV c))
-> SymbolicT IO (SBV b)
-> SymbolicT IO (SBV c -> (SBV a, SBV b, SBV c))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nb -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)) SymbolicT IO (SBV c -> (SBV a, SBV b, SBV c))
-> SymbolicT IO (SBV c) -> SymbolicT IO (SBV a, SBV b, SBV c)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nc -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc))
                                                       [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel (StepArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool) t
SBV a -> SBV b -> SBV c -> (SBool, TPProofRaw (SBV t))
steps SBV a
aa SBV b
ab SBV c
ac)
                               (Forall na a -> Forall nb b -> Forall nc c -> SBool
result (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c),) (CalcStrategy -> (SBool, CalcStrategy))
-> Symbolic CalcStrategy -> Symbolic (SBool, CalcStrategy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SBool, TPProofRaw (SBV t))
-> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
forall a.
SymVal a =>
(SBool, TPProofRaw (SBV a))
-> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
mkCalcSteps (StepArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool) t
SBV a -> SBV b -> SBV c -> (SBool, TPProofRaw (SBV t))
steps SBV a
a SBV b
b SBV c
c) [Int] -> Symbolic SBool
q

-- | Chaining lemmas that depend on four extra variables.
instance (KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b, KnownSymbol nc, SymVal c, KnownSymbol nd, SymVal d) => Calc (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool) where
   calcSteps :: forall t.
(SymVal t, EqSymbolic (SBV t)) =>
(Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
-> StepArgs
     (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
     t
-> Symbolic (SBool, CalcStrategy)
calcSteps Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool
result StepArgs
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
  t
steps = do (SBV a
a, SBV b
b, SBV c
c, SBV d
d) <- (,,,) (SBV a -> SBV b -> SBV c -> SBV d -> (SBV a, SBV b, SBV c, SBV d))
-> SymbolicT IO (SBV a)
-> SymbolicT
     IO (SBV b -> SBV c -> SBV d -> (SBV a, SBV b, SBV c, SBV d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy na -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)) SymbolicT
  IO (SBV b -> SBV c -> SBV d -> (SBV a, SBV b, SBV c, SBV d))
-> SymbolicT IO (SBV b)
-> SymbolicT IO (SBV c -> SBV d -> (SBV a, SBV b, SBV c, SBV d))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nb -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)) SymbolicT IO (SBV c -> SBV d -> (SBV a, SBV b, SBV c, SBV d))
-> SymbolicT IO (SBV c)
-> SymbolicT IO (SBV d -> (SBV a, SBV b, SBV c, SBV d))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nc -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)) SymbolicT IO (SBV d -> (SBV a, SBV b, SBV c, SBV d))
-> SymbolicT IO (SBV d)
-> SymbolicT IO (SBV a, SBV b, SBV c, SBV d)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV d)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nd -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nd))
                               let q :: [Int] -> Symbolic SBool
q [Int]
checkedLabel = do (SBool, TPProofRaw (SBV t))
sb <- StepArgs
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
  t
SBV a -> SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t))
steps (SBV a -> SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT
     IO (SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy na -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)) SymbolicT
  IO (SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b)
-> SymbolicT IO (SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nb -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)) SymbolicT IO (SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV c)
-> SymbolicT IO (SBV d -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nc -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)) SymbolicT IO (SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV d) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV d)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nd -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nd))
                                                       [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel (SBool, TPProofRaw (SBV t))
sb
                               (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool
result (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d),) (CalcStrategy -> (SBool, CalcStrategy))
-> Symbolic CalcStrategy -> Symbolic (SBool, CalcStrategy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SBool, TPProofRaw (SBV t))
-> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
forall a.
SymVal a =>
(SBool, TPProofRaw (SBV a))
-> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
mkCalcSteps (StepArgs
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
  t
SBV a -> SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t))
steps SBV a
a SBV b
b SBV c
c SBV d
d) [Int] -> Symbolic SBool
q

-- | Chaining lemmas that depend on five extra variables.
instance (KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b, KnownSymbol nc, SymVal c, KnownSymbol nd, SymVal d, KnownSymbol ne, SymVal e)
      => Calc (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) where
   calcSteps :: forall t.
(SymVal t, EqSymbolic (SBV t)) =>
(Forall na a
 -> Forall nb b
 -> Forall nc c
 -> Forall nd d
 -> Forall ne e
 -> SBool)
-> StepArgs
     (Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
     t
-> Symbolic (SBool, CalcStrategy)
calcSteps Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result StepArgs
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
  t
steps = do (SBV a
a, SBV b
b, SBV c
c, SBV d
d, SBV e
e) <- (,,,,) (SBV a
 -> SBV b
 -> SBV c
 -> SBV d
 -> SBV e
 -> (SBV a, SBV b, SBV c, SBV d, SBV e))
-> SymbolicT IO (SBV a)
-> SymbolicT
     IO
     (SBV b
      -> SBV c -> SBV d -> SBV e -> (SBV a, SBV b, SBV c, SBV d, SBV e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy na -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)) SymbolicT
  IO
  (SBV b
   -> SBV c -> SBV d -> SBV e -> (SBV a, SBV b, SBV c, SBV d, SBV e))
-> SymbolicT IO (SBV b)
-> SymbolicT
     IO (SBV c -> SBV d -> SBV e -> (SBV a, SBV b, SBV c, SBV d, SBV e))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nb -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)) SymbolicT
  IO (SBV c -> SBV d -> SBV e -> (SBV a, SBV b, SBV c, SBV d, SBV e))
-> SymbolicT IO (SBV c)
-> SymbolicT
     IO (SBV d -> SBV e -> (SBV a, SBV b, SBV c, SBV d, SBV e))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nc -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)) SymbolicT
  IO (SBV d -> SBV e -> (SBV a, SBV b, SBV c, SBV d, SBV e))
-> SymbolicT IO (SBV d)
-> SymbolicT IO (SBV e -> (SBV a, SBV b, SBV c, SBV d, SBV e))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV d)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nd -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nd)) SymbolicT IO (SBV e -> (SBV a, SBV b, SBV c, SBV d, SBV e))
-> SymbolicT IO (SBV e)
-> SymbolicT IO (SBV a, SBV b, SBV c, SBV d, SBV e)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV e)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy ne -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ne))
                               let q :: [Int] -> Symbolic SBool
q [Int]
checkedLabel = do (SBool, TPProofRaw (SBV t))
sb <- StepArgs
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
  t
SBV a
-> SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t))
steps (SBV a
 -> SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT
     IO
     (SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy na -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)) SymbolicT
  IO
  (SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b)
-> SymbolicT
     IO (SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nb -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)) SymbolicT
  IO (SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV c)
-> SymbolicT IO (SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nc -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)) SymbolicT IO (SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV d)
-> SymbolicT IO (SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV d)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy nd -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nd)) SymbolicT IO (SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV e) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV e)
forall a. SymVal a => String -> Symbolic (SBV a)
free (Proxy ne -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ne))
                                                       [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel (SBool, TPProofRaw (SBV t))
sb
                               (Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d) (SBV e -> Forall ne e
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV e
e),) (CalcStrategy -> (SBool, CalcStrategy))
-> Symbolic CalcStrategy -> Symbolic (SBool, CalcStrategy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SBool, TPProofRaw (SBV t))
-> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
forall a.
SymVal a =>
(SBool, TPProofRaw (SBV a))
-> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
mkCalcSteps (StepArgs
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
  t
SBV a
-> SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t))
steps SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e) [Int] -> Symbolic SBool
q

-- | Captures the schema for an inductive proof. Base case might be nothing, to cover strong induction.
data InductionStrategy = InductionStrategy { InductionStrategy -> SBool
inductionIntros     :: SBool
                                           , InductionStrategy -> Maybe SBool
inductionMeasure    :: Maybe SBool
                                           , InductionStrategy -> Maybe SBool
inductionBaseCase   :: Maybe SBool
                                           , InductionStrategy -> TPProof
inductionProofTree  :: TPProof
                                           , InductionStrategy -> SBool
inductiveStep       :: SBool
                                           , InductionStrategy -> [Int] -> Symbolic SBool
inductiveQCInstance :: [Int] -> Symbolic SBool
                                           }

-- | Are we doing regular induction or measure based general induction?
data InductionStyle = RegularInduction | GeneralInduction

getInductionStrategySaturatables :: InductionStrategy -> [SBool]
getInductionStrategySaturatables :: InductionStrategy -> [SBool]
getInductionStrategySaturatables (InductionStrategy SBool
inductionIntros
                                                    Maybe SBool
inductionMeasure
                                                    Maybe SBool
inductionBaseCase
                                                    TPProof
inductionProofSteps
                                                    SBool
inductiveStep
                                                    [Int] -> Symbolic SBool
_inductiveQCInstance)
  = SBool
inductionIntros SBool -> [SBool] -> [SBool]
forall a. a -> [a] -> [a]
: SBool
inductiveStep SBool -> [SBool] -> [SBool]
forall a. a -> [a] -> [a]
: TPProof -> [SBool]
proofTreeSaturatables TPProof
inductionProofSteps [SBool] -> [SBool] -> [SBool]
forall a. [a] -> [a] -> [a]
++ Maybe SBool -> [SBool]
forall a. Maybe a -> [a]
maybeToList Maybe SBool
inductionBaseCase [SBool] -> [SBool] -> [SBool]
forall a. [a] -> [a] -> [a]
++ Maybe SBool -> [SBool]
forall a. Maybe a -> [a]
maybeToList Maybe SBool
inductionMeasure

-- | A class for doing regular inductive proofs.
class Inductive a where
   type IHType a :: Type
   type IHArg  a :: Type

   -- | Inductively prove a lemma, using the default config.
   -- Inductive proofs over lists only hold for finite lists. We also assume that all functions involved are terminating. SBV does not prove termination, so only
   -- partial correctness is guaranteed if non-terminating functions are involved.
   induct  :: (Proposition a, SymVal t, EqSymbolic (SBV t)) => String -> a -> (Proof (IHType a) -> IHArg a -> IStepArgs a t) -> TP (Proof a)

   -- | Same as 'induct', but with the given solver configuration.
   -- Inductive proofs over lists only hold for finite lists. We also assume that all functions involved are terminating. SBV does not prove termination, so only
   -- partial correctness is guaranteed if non-terminating functions are involved.
   inductWith :: (Proposition a, SymVal t, EqSymbolic (SBV t)) => SMTConfig -> String -> a -> (Proof (IHType a) -> IHArg a -> IStepArgs a t) -> TP (Proof a)

   induct         String
nm a
p Proof (IHType a) -> IHArg a -> IStepArgs a t
steps = TP SMTConfig
getTPConfig TP SMTConfig -> (SMTConfig -> TP (Proof a)) -> TP (Proof a)
forall a b. TP a -> (a -> TP b) -> TP b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SMTConfig
cfg  -> SMTConfig
-> String
-> a
-> (Proof (IHType a) -> IHArg a -> IStepArgs a t)
-> TP (Proof a)
forall t.
(Proposition a, SymVal t, EqSymbolic (SBV t)) =>
SMTConfig
-> String
-> a
-> (Proof (IHType a) -> IHArg a -> IStepArgs a t)
-> TP (Proof a)
forall a t.
(Inductive a, Proposition a, SymVal t, EqSymbolic (SBV t)) =>
SMTConfig
-> String
-> a
-> (Proof (IHType a) -> IHArg a -> IStepArgs a t)
-> TP (Proof a)
inductWith                             SMTConfig
cfg                   String
nm a
p Proof (IHType a) -> IHArg a -> IStepArgs a t
steps
   inductWith SMTConfig
cfg String
nm a
p Proof (IHType a) -> IHArg a -> IStepArgs a t
steps = TP SMTConfig
getTPConfig TP SMTConfig -> (SMTConfig -> TP (Proof a)) -> TP (Proof a)
forall a b. TP a -> (a -> TP b) -> TP b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SMTConfig
cfg' -> InductionStyle
-> Bool
-> SMTConfig
-> String
-> a
-> Symbolic InductionStrategy
-> TP (Proof a)
forall a.
Proposition a =>
InductionStyle
-> Bool
-> SMTConfig
-> String
-> a
-> Symbolic InductionStrategy
-> TP (Proof a)
inductionEngine InductionStyle
RegularInduction Bool
False (SMTConfig -> SMTConfig -> SMTConfig
tpMergeCfg SMTConfig
cfg SMTConfig
cfg') String
nm a
p (a
-> (Proof (IHType a) -> IHArg a -> IStepArgs a t)
-> Symbolic InductionStrategy
forall t.
(Proposition a, SymVal t, EqSymbolic (SBV t)) =>
a
-> (Proof (IHType a) -> IHArg a -> IStepArgs a t)
-> Symbolic InductionStrategy
forall a t.
(Inductive a, Proposition a, SymVal t, EqSymbolic (SBV t)) =>
a
-> (Proof (IHType a) -> IHArg a -> IStepArgs a t)
-> Symbolic InductionStrategy
inductionStrategy a
p Proof (IHType a) -> IHArg a -> IStepArgs a t
steps)

   -- | Internal, shouldn't be needed outside the library
   {-# MINIMAL inductionStrategy #-}
   inductionStrategy :: (Proposition a, SymVal t, EqSymbolic (SBV t)) => a -> (Proof (IHType a) -> IHArg a -> IStepArgs a t) -> Symbolic InductionStrategy

-- | A class of values, capturing the zero of a measure value
class OrdSymbolic (SBV a) => Zero a where
  zero :: SBV a

-- | An integer as a measure
instance Zero Integer where
   zero :: SBV Integer
zero = Integer -> SBV Integer
forall a. SymVal a => a -> SBV a
literal Integer
0

-- | A tuple of integers as a measure
instance Zero (Integer, Integer) where
  zero :: SBV (Integer, Integer)
zero = (Integer, Integer) -> SBV (Integer, Integer)
forall a. SymVal a => a -> SBV a
literal (Integer
0, Integer
0)

-- | A triple of integers as a measure
instance Zero (Integer, Integer, Integer) where
  zero :: SBV (Integer, Integer, Integer)
zero = (Integer, Integer, Integer) -> SBV (Integer, Integer, Integer)
forall a. SymVal a => a -> SBV a
literal (Integer
0, Integer
0, Integer
0)

-- | A quadruple of integers as a measure
instance Zero (Integer, Integer, Integer, Integer) where
  zero :: SBV (Integer, Integer, Integer, Integer)
zero = (Integer, Integer, Integer, Integer)
-> SBV (Integer, Integer, Integer, Integer)
forall a. SymVal a => a -> SBV a
literal (Integer
0, Integer
0, Integer
0, Integer
0)

instance Zero (Integer, Integer, Integer, Integer, Integer) where
  zero :: SBV (Integer, Integer, Integer, Integer, Integer)
zero = (Integer, Integer, Integer, Integer, Integer)
-> SBV (Integer, Integer, Integer, Integer, Integer)
forall a. SymVal a => a -> SBV a
literal (Integer
0, Integer
0, Integer
0, Integer
0, Integer
0)

-- | A class for doing generalized measure based strong inductive proofs.
class SInductive a where
   -- | Inductively prove a lemma, using measure based induction, using the default config.
   -- Inductive proofs over lists only hold for finite lists. We also assume that all functions involved are terminating. SBV does not prove termination, so only
   -- partial correctness is guaranteed if non-terminating functions are involved.
   sInduct :: (Proposition a, Zero m, SymVal t, EqSymbolic (SBV t)) => String -> a -> MeasureArgs a m -> (Proof a -> StepArgs a t) -> TP (Proof a)

   -- | Same as 'sInduct', but with the given solver configuration.
   -- Inductive proofs over lists only hold for finite lists. We also assume that all functions involved are terminating. SBV does not prove termination, so only
   -- partial correctness is guaranteed if non-terminating functions are involved.
   sInductWith :: (Proposition a, Zero m, SymVal t, EqSymbolic (SBV t)) => SMTConfig -> String -> a -> MeasureArgs a m -> (Proof a -> StepArgs a t) -> TP (Proof a)

   sInduct         String
nm a
p MeasureArgs a m
m Proof a -> StepArgs a t
steps = TP SMTConfig
getTPConfig TP SMTConfig -> (SMTConfig -> TP (Proof a)) -> TP (Proof a)
forall a b. TP a -> (a -> TP b) -> TP b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SMTConfig
cfg  -> SMTConfig
-> String
-> a
-> MeasureArgs a m
-> (Proof a -> StepArgs a t)
-> TP (Proof a)
forall a m t.
(SInductive a, Proposition a, Zero m, SymVal t,
 EqSymbolic (SBV t)) =>
SMTConfig
-> String
-> a
-> MeasureArgs a m
-> (Proof a -> StepArgs a t)
-> TP (Proof a)
forall m t.
(Proposition a, Zero m, SymVal t, EqSymbolic (SBV t)) =>
SMTConfig
-> String
-> a
-> MeasureArgs a m
-> (Proof a -> StepArgs a t)
-> TP (Proof a)
sInductWith                            SMTConfig
cfg                   String
nm a
p MeasureArgs a m
m Proof a -> StepArgs a t
steps
   sInductWith SMTConfig
cfg String
nm a
p MeasureArgs a m
m Proof a -> StepArgs a t
steps = TP SMTConfig
getTPConfig TP SMTConfig -> (SMTConfig -> TP (Proof a)) -> TP (Proof a)
forall a b. TP a -> (a -> TP b) -> TP b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SMTConfig
cfg' -> InductionStyle
-> Bool
-> SMTConfig
-> String
-> a
-> Symbolic InductionStrategy
-> TP (Proof a)
forall a.
Proposition a =>
InductionStyle
-> Bool
-> SMTConfig
-> String
-> a
-> Symbolic InductionStrategy
-> TP (Proof a)
inductionEngine InductionStyle
GeneralInduction Bool
False (SMTConfig -> SMTConfig -> SMTConfig
tpMergeCfg SMTConfig
cfg SMTConfig
cfg') String
nm a
p (a
-> MeasureArgs a m
-> (Proof a -> StepArgs a t)
-> Symbolic InductionStrategy
forall a m t.
(SInductive a, Proposition a, Zero m, SymVal t,
 EqSymbolic (SBV t)) =>
a
-> MeasureArgs a m
-> (Proof a -> StepArgs a t)
-> Symbolic InductionStrategy
forall m t.
(Proposition a, Zero m, SymVal t, EqSymbolic (SBV t)) =>
a
-> MeasureArgs a m
-> (Proof a -> StepArgs a t)
-> Symbolic InductionStrategy
sInductionStrategy a
p MeasureArgs a m
m Proof a -> StepArgs a t
steps)

   -- | Internal, shouldn't be needed outside the library
   {-# MINIMAL sInductionStrategy #-}
   sInductionStrategy :: (Proposition a, Zero m, SymVal t, EqSymbolic (SBV t)) => a -> MeasureArgs a m -> (Proof a -> StepArgs a t) -> Symbolic InductionStrategy

-- | Do an inductive proof, based on the given strategy
inductionEngine :: Proposition a => InductionStyle -> Bool -> SMTConfig -> String -> a -> Symbolic InductionStrategy -> TP (Proof a)
inductionEngine :: forall a.
Proposition a =>
InductionStyle
-> Bool
-> SMTConfig
-> String
-> a
-> Symbolic InductionStrategy
-> TP (Proof a)
inductionEngine InductionStyle
style Bool
tagTheorem SMTConfig
cfg String
nm a
result Symbolic InductionStrategy
getStrategy = String -> TP (Proof a) -> TP (Proof a)
forall a. Typeable a => String -> TP (Proof a) -> TP (Proof a)
withProofCache String
nm (TP (Proof a) -> TP (Proof a)) -> TP (Proof a) -> TP (Proof a)
forall a b. (a -> b) -> a -> b
$ do
   TPState
tpSt <- TP TPState
getTPState
   TPUnique
u    <- TP TPUnique
tpGetNextUnique

   IO (Proof a) -> TP (Proof a)
forall a. IO a -> TP a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Proof a) -> TP (Proof a)) -> IO (Proof a) -> TP (Proof a)
forall a b. (a -> b) -> a -> b
$ SMTConfig -> Symbolic (Proof a) -> IO (Proof a)
forall a. SMTConfig -> Symbolic a -> IO a
runSMTWith SMTConfig
cfg (Symbolic (Proof a) -> IO (Proof a))
-> Symbolic (Proof a) -> IO (Proof a)
forall a b. (a -> b) -> a -> b
$ do

      a -> SymbolicT IO ()
forall (m :: * -> *) a.
(Monad m, MonadIO m, SolverContext m, QSaturate m a) =>
a -> m ()
qSaturateSavingObservables a
result -- make sure we saturate the result, i.e., get all it's UI's, types etc. pop out

      let qual :: String
qual = case InductionStyle
style of
                   InductionStyle
RegularInduction -> String
""
                   InductionStyle
GeneralInduction  -> String
" (strong)"

      SMTConfig -> String -> SymbolicT IO ()
forall (m :: * -> *). MonadIO m => SMTConfig -> String -> m ()
message SMTConfig
cfg (String -> SymbolicT IO ()) -> String -> SymbolicT IO ()
forall a b. (a -> b) -> a -> b
$ String
"Inductive " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Bool
tagTheorem then String
"theorem" else String
"lemma") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qual String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

      strategy :: InductionStrategy
strategy@InductionStrategy { SBool
inductionIntros :: InductionStrategy -> SBool
inductionIntros :: SBool
inductionIntros
                                 , Maybe SBool
inductionMeasure :: InductionStrategy -> Maybe SBool
inductionMeasure :: Maybe SBool
inductionMeasure
                                 , Maybe SBool
inductionBaseCase :: InductionStrategy -> Maybe SBool
inductionBaseCase :: Maybe SBool
inductionBaseCase
                                 , TPProof
inductionProofTree :: InductionStrategy -> TPProof
inductionProofTree :: TPProof
inductionProofTree
                                 , SBool
inductiveStep :: InductionStrategy -> SBool
inductiveStep :: SBool
inductiveStep
                                 , [Int] -> Symbolic SBool
inductiveQCInstance :: InductionStrategy -> [Int] -> Symbolic SBool
inductiveQCInstance :: [Int] -> Symbolic SBool
inductiveQCInstance
                                 } <- Symbolic InductionStrategy
getStrategy

      (SBool -> SymbolicT IO ()) -> [SBool] -> SymbolicT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SBool -> SymbolicT IO ()
forall (m :: * -> *) a.
(Monad m, MonadIO m, SolverContext m, QSaturate m a) =>
a -> m ()
qSaturateSavingObservables ([SBool] -> SymbolicT IO ()) -> [SBool] -> SymbolicT IO ()
forall a b. (a -> b) -> a -> b
$ InductionStrategy -> [SBool]
getInductionStrategySaturatables InductionStrategy
strategy

      Query (Proof a) -> Symbolic (Proof a)
forall a. Query a -> Symbolic a
query (Query (Proof a) -> Symbolic (Proof a))
-> Query (Proof a) -> Symbolic (Proof a)
forall a b. (a -> b) -> a -> b
$ do

       case Maybe SBool
inductionMeasure of
          Maybe SBool
Nothing -> [String] -> Query ()
queryDebug [String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Induction" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qual String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", there is no custom measure to show non-negativeness."]
          Just SBool
ms -> do [String] -> Query ()
queryDebug [String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Induction, proving measure is always non-negative:"]
                        SMTConfig
-> TPState
-> String
-> Int
-> TPProofContext
-> Maybe SBool
-> SBool
-> [(String, SVal)]
-> ((Int, Maybe NominalDiffTime) -> IO ())
-> Query ()
forall (m :: * -> *) a r.
(SolverContext m, MonadIO m, MonadQuery m, MonadSymbolic m,
 Proposition a) =>
SMTConfig
-> TPState
-> String
-> Int
-> TPProofContext
-> Maybe SBool
-> a
-> [(String, SVal)]
-> ((Int, Maybe NominalDiffTime) -> IO r)
-> m r
smtProofStep SMTConfig
cfg TPState
tpSt String
"Step" Int
1
                                              (Bool -> String -> [String] -> [String] -> TPProofContext
TPProofStep Bool
False String
nm [] [String
"Measure is non-negative"])
                                              (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
inductionIntros)
                                              SBool
ms
                                              []
                                              (\(Int, Maybe NominalDiffTime)
d -> SMTConfig
-> String
-> (Int, Maybe NominalDiffTime)
-> [NominalDiffTime]
-> IO ()
finishTP SMTConfig
cfg String
"Q.E.D." (Int, Maybe NominalDiffTime)
d [])
       case Maybe SBool
inductionBaseCase of
          Maybe SBool
Nothing -> [String] -> Query ()
queryDebug [String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Induction" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
qual String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", there is no base case to prove."]
          Just SBool
bc -> do [String] -> Query ()
queryDebug [String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Induction, proving base case:"]
                        SMTConfig
-> TPState
-> String
-> Int
-> TPProofContext
-> Maybe SBool
-> SBool
-> [(String, SVal)]
-> ((Int, Maybe NominalDiffTime) -> IO ())
-> Query ()
forall (m :: * -> *) a r.
(SolverContext m, MonadIO m, MonadQuery m, MonadSymbolic m,
 Proposition a) =>
SMTConfig
-> TPState
-> String
-> Int
-> TPProofContext
-> Maybe SBool
-> a
-> [(String, SVal)]
-> ((Int, Maybe NominalDiffTime) -> IO r)
-> m r
smtProofStep SMTConfig
cfg TPState
tpSt String
"Step" Int
1
                                              (Bool -> String -> [String] -> [String] -> TPProofContext
TPProofStep Bool
False String
nm [] [String
"Base"])
                                              (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
inductionIntros)
                                              SBool
bc
                                              []
                                              (\(Int, Maybe NominalDiffTime)
d -> SMTConfig
-> String
-> (Int, Maybe NominalDiffTime)
-> [NominalDiffTime]
-> IO ()
finishTP SMTConfig
cfg String
"Q.E.D." (Int, Maybe NominalDiffTime)
d [])

       SMTConfig
-> TPState
-> String
-> (a, SBool)
-> SBool
-> TPProof
-> TPUnique
-> ([Int] -> Symbolic SBool)
-> Query (Proof a)
forall a.
Proposition a =>
SMTConfig
-> TPState
-> String
-> (a, SBool)
-> SBool
-> TPProof
-> TPUnique
-> ([Int] -> Symbolic SBool)
-> Query (Proof a)
proveProofTree SMTConfig
cfg TPState
tpSt String
nm (a
result, SBool
inductiveStep) SBool
inductionIntros TPProof
inductionProofTree TPUnique
u [Int] -> Symbolic SBool
inductiveQCInstance

-- Induction strategy helper
mkIndStrategy :: (SymVal a, EqSymbolic (SBV a)) => Maybe SBool -> Maybe SBool -> (SBool, TPProofRaw (SBV a)) -> SBool -> ([Int] -> Symbolic SBool) -> Symbolic InductionStrategy
mkIndStrategy :: forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
mbMeasure Maybe SBool
mbBaseCase (SBool, TPProofRaw (SBV a))
indSteps SBool
step [Int] -> Symbolic SBool
indQCInstance = do
        CalcStrategy { SBool
calcIntros :: CalcStrategy -> SBool
calcIntros :: SBool
calcIntros, TPProof
calcProofTree :: CalcStrategy -> TPProof
calcProofTree :: TPProof
calcProofTree, [Int] -> Symbolic SBool
calcQCInstance :: CalcStrategy -> [Int] -> Symbolic SBool
calcQCInstance :: [Int] -> Symbolic SBool
calcQCInstance } <- (SBool, TPProofRaw (SBV a))
-> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
forall a.
SymVal a =>
(SBool, TPProofRaw (SBV a))
-> ([Int] -> Symbolic SBool) -> Symbolic CalcStrategy
mkCalcSteps (SBool, TPProofRaw (SBV a))
indSteps [Int] -> Symbolic SBool
indQCInstance
        InductionStrategy -> Symbolic InductionStrategy
forall a. a -> SymbolicT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InductionStrategy -> Symbolic InductionStrategy)
-> InductionStrategy -> Symbolic InductionStrategy
forall a b. (a -> b) -> a -> b
$ InductionStrategy { inductionIntros :: SBool
inductionIntros     = SBool
calcIntros
                                 , inductionMeasure :: Maybe SBool
inductionMeasure    = Maybe SBool
mbMeasure
                                 , inductionBaseCase :: Maybe SBool
inductionBaseCase   = Maybe SBool
mbBaseCase
                                 , inductionProofTree :: TPProof
inductionProofTree  = TPProof
calcProofTree
                                 , inductiveStep :: SBool
inductiveStep       = SBool
step
                                 , inductiveQCInstance :: [Int] -> Symbolic SBool
inductiveQCInstance = [Int] -> Symbolic SBool
calcQCInstance
                                 }

-- | Create a new variable with the given name, return both the variable and the name
mkVar :: (KnownSymbol n, SymVal a) => proxy n -> Symbolic (SBV a, String)
mkVar :: forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar proxy n
x = do let nn :: String
nn = proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal proxy n
x
             SBV a
n <- String -> Symbolic (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nn
             (SBV a, String) -> Symbolic (SBV a, String)
forall a. a -> SymbolicT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SBV a
n, String
nn)

-- | Create a new variable with the given name, return both the variable and the name. List version.
mkLVar :: (KnownSymbol n, SymVal a) => proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar :: forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar proxy n
x = do let nxs :: String
nxs = proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal proxy n
x
                  nx :: String
nx  = String -> String
singular String
nxs
              SBV a
e  <- String -> Symbolic (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nx
              SList a
es <- String -> Symbolic (SList a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nxs
              (SBV a, SList a, String, String, String)
-> Symbolic (SBV a, SList a, String, String, String)
forall a. a -> SymbolicT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SBV a
e, SList a
es, String
nx, String
nxs, String
nx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nxs)

-- | Helper for induction result
indResult :: [String] -> SBool -> SBool
indResult :: [String] -> SBool -> SBool
indResult [String]
nms = (Bool -> Bool) -> String -> SBool -> SBool
forall a. SymVal a => (a -> Bool) -> String -> SBV a -> SBV a
observeIf Bool -> Bool
not (String
"P(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
nms String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")

-- | Induction over 'SInteger'
instance KnownSymbol nn => Inductive (Forall nn Integer -> SBool) where
  type IHType (Forall nn Integer -> SBool) = SBool
  type IHArg  (Forall nn Integer -> SBool) = SInteger

  inductionStrategy :: forall t.
(Proposition (Forall nn Integer -> SBool), SymVal t,
 EqSymbolic (SBV t)) =>
(Forall nn Integer -> SBool)
-> (Proof (IHType (Forall nn Integer -> SBool))
    -> IHArg (Forall nn Integer -> SBool)
    -> IStepArgs (Forall nn Integer -> SBool) t)
-> Symbolic InductionStrategy
inductionStrategy Forall nn Integer -> SBool
result Proof (IHType (Forall nn Integer -> SBool))
-> IHArg (Forall nn Integer -> SBool)
-> IStepArgs (Forall nn Integer -> SBool) t
steps = do
       (SBV Integer
n, String
nn) <- Proxy nn -> Symbolic (SBV Integer, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nn)

       let bc :: SBool
bc = Forall nn Integer -> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV Integer
0)
           ih :: Proof SBool
ih = String -> SBool -> Proof SBool
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (SBV Integer
n SBV Integer -> SBV Integer -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.>= SBV Integer
forall a. Zero a => SBV a
zero SBool -> SBool -> SBool
.=> Forall nn Integer -> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV Integer
n))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof (IHType (Forall nn Integer -> SBool))
-> IHArg (Forall nn Integer -> SBool)
-> IStepArgs (Forall nn Integer -> SBool) t
steps Proof SBool
Proof (IHType (Forall nn Integer -> SBool))
ih SBV Integer
IHArg (Forall nn Integer -> SBool)
n)
                     ([String] -> SBool -> SBool
indResult [String
nn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"+1"] (Forall nn Integer -> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV Integer
nSBV Integer -> SBV Integer -> SBV Integer
forall a. Num a => a -> a -> a
+SBV Integer
1))))
                     (\[Int]
checkedLabel -> String -> Symbolic (SBV Integer)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nn Symbolic (SBV Integer)
-> (SBV Integer -> Symbolic SBool) -> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> (SBV Integer -> (SBool, TPProofRaw (SBV t)))
-> SBV Integer
-> Symbolic SBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof (IHType (Forall nn Integer -> SBool))
-> IHArg (Forall nn Integer -> SBool)
-> IStepArgs (Forall nn Integer -> SBool) t
steps Proof SBool
Proof (IHType (Forall nn Integer -> SBool))
ih)

-- | Induction over 'SInteger', taking an extra argument
instance (KnownSymbol nn, KnownSymbol na, SymVal a) => Inductive (Forall nn Integer -> Forall na a -> SBool) where
  type IHType (Forall nn Integer -> Forall na a -> SBool) = Forall na a -> SBool
  type IHArg  (Forall nn Integer -> Forall na a -> SBool) = SInteger

  inductionStrategy :: forall t.
(Proposition (Forall nn Integer -> Forall na a -> SBool), SymVal t,
 EqSymbolic (SBV t)) =>
(Forall nn Integer -> Forall na a -> SBool)
-> (Proof (IHType (Forall nn Integer -> Forall na a -> SBool))
    -> IHArg (Forall nn Integer -> Forall na a -> SBool)
    -> IStepArgs (Forall nn Integer -> Forall na a -> SBool) t)
-> Symbolic InductionStrategy
inductionStrategy Forall nn Integer -> Forall na a -> SBool
result Proof (IHType (Forall nn Integer -> Forall na a -> SBool))
-> IHArg (Forall nn Integer -> Forall na a -> SBool)
-> IStepArgs (Forall nn Integer -> Forall na a -> SBool) t
steps = do
       (SBV Integer
n, String
nn) <- Proxy nn -> Symbolic (SBV Integer, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nn)
       (SBV a
a, String
na) <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)

       let bc :: SBool
bc = Forall nn Integer -> Forall na a -> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV Integer
0) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a)
           ih :: Proof (Forall na a -> SBool)
ih = String -> (Forall na a -> SBool) -> Proof (Forall na a -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) -> SBV Integer
n SBV Integer -> SBV Integer -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.>= SBV Integer
forall a. Zero a => SBV a
zero SBool -> SBool -> SBool
.=> Forall nn Integer -> Forall na a -> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV Integer
n) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a'))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof (IHType (Forall nn Integer -> Forall na a -> SBool))
-> IHArg (Forall nn Integer -> Forall na a -> SBool)
-> IStepArgs (Forall nn Integer -> Forall na a -> SBool) t
steps Proof (IHType (Forall nn Integer -> Forall na a -> SBool))
Proof (Forall na a -> SBool)
ih SBV Integer
IHArg (Forall nn Integer -> Forall na a -> SBool)
n SBV a
a)
                     ([String] -> SBool -> SBool
indResult [String
nn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"+1", String
na] (Forall nn Integer -> Forall na a -> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV Integer
nSBV Integer -> SBV Integer -> SBV Integer
forall a. Num a => a -> a -> a
+SBV Integer
1)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a)))
                     (\[Int]
checkedLabel -> Proof (IHType (Forall nn Integer -> Forall na a -> SBool))
-> IHArg (Forall nn Integer -> Forall na a -> SBool)
-> IStepArgs (Forall nn Integer -> Forall na a -> SBool) t
steps Proof (IHType (Forall nn Integer -> Forall na a -> SBool))
Proof (Forall na a -> SBool)
ih (SBV Integer -> SBV a -> (SBool, TPProofRaw (SBV t)))
-> Symbolic (SBV Integer)
-> SymbolicT IO (SBV a -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Symbolic (SBV Integer)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nn SymbolicT IO (SBV a -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Induction over 'SInteger', taking two extra arguments
instance (KnownSymbol nn, KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b) => Inductive (Forall nn Integer -> Forall na a -> Forall nb b -> SBool) where
  type IHType (Forall nn Integer -> Forall na a -> Forall nb b -> SBool) = Forall na a -> Forall nb b -> SBool
  type IHArg  (Forall nn Integer -> Forall na a -> Forall nb b -> SBool) = SInteger

  inductionStrategy :: forall t.
(Proposition
   (Forall nn Integer -> Forall na a -> Forall nb b -> SBool),
 SymVal t, EqSymbolic (SBV t)) =>
(Forall nn Integer -> Forall na a -> Forall nb b -> SBool)
-> (Proof
      (IHType (Forall nn Integer -> Forall na a -> Forall nb b -> SBool))
    -> IHArg (Forall nn Integer -> Forall na a -> Forall nb b -> SBool)
    -> IStepArgs
         (Forall nn Integer -> Forall na a -> Forall nb b -> SBool) t)
-> Symbolic InductionStrategy
inductionStrategy Forall nn Integer -> Forall na a -> Forall nb b -> SBool
result Proof
  (IHType (Forall nn Integer -> Forall na a -> Forall nb b -> SBool))
-> IHArg (Forall nn Integer -> Forall na a -> Forall nb b -> SBool)
-> IStepArgs
     (Forall nn Integer -> Forall na a -> Forall nb b -> SBool) t
steps = do
       (SBV Integer
n, String
nn) <- Proxy nn -> Symbolic (SBV Integer, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nn)
       (SBV a
a, String
na) <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
       (SBV b
b, String
nb) <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)

       let bc :: SBool
bc = Forall nn Integer -> Forall na a -> Forall nb b -> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV Integer
0) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b)
           ih :: Proof (Forall na a -> Forall nb b -> SBool)
ih = String
-> (Forall na a -> Forall nb b -> SBool)
-> Proof (Forall na a -> Forall nb b -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) -> SBV Integer
n SBV Integer -> SBV Integer -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.>= SBV Integer
forall a. Zero a => SBV a
zero SBool -> SBool -> SBool
.=> Forall nn Integer -> Forall na a -> Forall nb b -> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV Integer
n) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b'))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof
  (IHType (Forall nn Integer -> Forall na a -> Forall nb b -> SBool))
-> IHArg (Forall nn Integer -> Forall na a -> Forall nb b -> SBool)
-> IStepArgs
     (Forall nn Integer -> Forall na a -> Forall nb b -> SBool) t
steps Proof
  (IHType (Forall nn Integer -> Forall na a -> Forall nb b -> SBool))
Proof (Forall na a -> Forall nb b -> SBool)
ih SBV Integer
IHArg (Forall nn Integer -> Forall na a -> Forall nb b -> SBool)
n SBV a
a SBV b
b)
                     ([String] -> SBool -> SBool
indResult [String
nn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"+1", String
na, String
nb] (Forall nn Integer -> Forall na a -> Forall nb b -> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV Integer
nSBV Integer -> SBV Integer -> SBV Integer
forall a. Num a => a -> a -> a
+SBV Integer
1)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b)))
                     (\[Int]
checkedLabel -> Proof
  (IHType (Forall nn Integer -> Forall na a -> Forall nb b -> SBool))
-> IHArg (Forall nn Integer -> Forall na a -> Forall nb b -> SBool)
-> IStepArgs
     (Forall nn Integer -> Forall na a -> Forall nb b -> SBool) t
steps Proof
  (IHType (Forall nn Integer -> Forall na a -> Forall nb b -> SBool))
Proof (Forall na a -> Forall nb b -> SBool)
ih (SBV Integer -> SBV a -> SBV b -> (SBool, TPProofRaw (SBV t)))
-> Symbolic (SBV Integer)
-> SymbolicT IO (SBV a -> SBV b -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Symbolic (SBV Integer)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nn SymbolicT IO (SBV a -> SBV b -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT IO (SBV b -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT IO (SBV b -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Induction over 'SInteger', taking three extra arguments
instance (KnownSymbol nn, KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b, KnownSymbol nc, SymVal c) => Inductive (Forall nn Integer -> Forall na a -> Forall nb b -> Forall nc c -> SBool) where
  type IHType (Forall nn Integer -> Forall na a -> Forall nb b -> Forall nc c -> SBool) = Forall na a -> Forall nb b -> Forall nc c -> SBool
  type IHArg  (Forall nn Integer -> Forall na a -> Forall nb b -> Forall nc c -> SBool) = SInteger

  inductionStrategy :: forall t.
(Proposition
   (Forall nn Integer
    -> Forall na a -> Forall nb b -> Forall nc c -> SBool),
 SymVal t, EqSymbolic (SBV t)) =>
(Forall nn Integer
 -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> (Proof
      (IHType
         (Forall nn Integer
          -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
    -> IHArg
         (Forall nn Integer
          -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
    -> IStepArgs
         (Forall nn Integer
          -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
         t)
-> Symbolic InductionStrategy
inductionStrategy Forall nn Integer
-> Forall na a -> Forall nb b -> Forall nc c -> SBool
result Proof
  (IHType
     (Forall nn Integer
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
-> IHArg
     (Forall nn Integer
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> IStepArgs
     (Forall nn Integer
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
     t
steps = do
       (SBV Integer
n, String
nn) <- Proxy nn -> Symbolic (SBV Integer, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nn)
       (SBV a
a, String
na) <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
       (SBV b
b, String
nb) <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)
       (SBV c
c, String
nc) <- Proxy nc -> Symbolic (SBV c, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)

       let bc :: SBool
bc = Forall nn Integer
-> Forall na a -> Forall nb b -> Forall nc c -> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV Integer
0) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c)
           ih :: Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
ih = String
-> (Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) (Forall SBV c
c' :: Forall nc c) -> SBV Integer
n SBV Integer -> SBV Integer -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.>= SBV Integer
forall a. Zero a => SBV a
zero SBool -> SBool -> SBool
.=> Forall nn Integer
-> Forall na a -> Forall nb b -> Forall nc c -> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV Integer
n) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b') (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c'))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof
  (IHType
     (Forall nn Integer
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
-> IHArg
     (Forall nn Integer
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> IStepArgs
     (Forall nn Integer
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
     t
steps Proof
  (IHType
     (Forall nn Integer
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
ih SBV Integer
IHArg
  (Forall nn Integer
   -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
n SBV a
a SBV b
b SBV c
c)
                     ([String] -> SBool -> SBool
indResult [String
nn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"+1", String
na, String
nb, String
nc] (Forall nn Integer
-> Forall na a -> Forall nb b -> Forall nc c -> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV Integer
nSBV Integer -> SBV Integer -> SBV Integer
forall a. Num a => a -> a -> a
+SBV Integer
1)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c)))
                     (\[Int]
checkedLabel -> Proof
  (IHType
     (Forall nn Integer
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
-> IHArg
     (Forall nn Integer
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> IStepArgs
     (Forall nn Integer
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
     t
steps Proof
  (IHType
     (Forall nn Integer
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
ih (SBV Integer
 -> SBV a -> SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
-> Symbolic (SBV Integer)
-> SymbolicT
     IO (SBV a -> SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Symbolic (SBV Integer)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nn SymbolicT
  IO (SBV a -> SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT IO (SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT IO (SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b)
-> SymbolicT IO (SBV c -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT IO (SBV c -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV c) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nc SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Induction over 'SInteger', taking four extra arguments
instance (KnownSymbol nn, KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b, KnownSymbol nc, SymVal c, KnownSymbol nd, SymVal d) => Inductive (Forall nn Integer -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool) where
  type IHType (Forall nn Integer -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool) = Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool
  type IHArg  (Forall nn Integer -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool) = SInteger

  inductionStrategy :: forall t.
(Proposition
   (Forall nn Integer
    -> Forall na a
    -> Forall nb b
    -> Forall nc c
    -> Forall nd d
    -> SBool),
 SymVal t, EqSymbolic (SBV t)) =>
(Forall nn Integer
 -> Forall na a
 -> Forall nb b
 -> Forall nc c
 -> Forall nd d
 -> SBool)
-> (Proof
      (IHType
         (Forall nn Integer
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> SBool))
    -> IHArg
         (Forall nn Integer
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> SBool)
    -> IStepArgs
         (Forall nn Integer
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> SBool)
         t)
-> Symbolic InductionStrategy
inductionStrategy Forall nn Integer
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> SBool
result Proof
  (IHType
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool))
-> IHArg
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
-> IStepArgs
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
     t
steps = do
       (SBV Integer
n, String
nn) <- Proxy nn -> Symbolic (SBV Integer, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nn)
       (SBV a
a, String
na) <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
       (SBV b
b, String
nb) <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)
       (SBV c
c, String
nc) <- Proxy nc -> Symbolic (SBV c, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)
       (SBV d
d, String
nd) <- Proxy nd -> Symbolic (SBV d, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nd)

       let bc :: SBool
bc = Forall nn Integer
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV Integer
0) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d)
           ih :: Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
ih = String
-> (Forall na a
    -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
-> Proof
     (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) (Forall SBV c
c' :: Forall nc c) (Forall SBV d
d' :: Forall nd d) -> SBV Integer
n SBV Integer -> SBV Integer -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.>= SBV Integer
forall a. Zero a => SBV a
zero SBool -> SBool -> SBool
.=> Forall nn Integer
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV Integer
n) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b') (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c') (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d'))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof
  (IHType
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool))
-> IHArg
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
-> IStepArgs
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
     t
steps Proof
  (IHType
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool))
Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
ih SBV Integer
IHArg
  (Forall nn Integer
   -> Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> SBool)
n SBV a
a SBV b
b SBV c
c SBV d
d)
                     ([String] -> SBool -> SBool
indResult [String
nn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"+1", String
na, String
nb, String
nc, String
nd] (Forall nn Integer
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV Integer
nSBV Integer -> SBV Integer -> SBV Integer
forall a. Num a => a -> a -> a
+SBV Integer
1)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d)))
                     (\[Int]
checkedLabel -> Proof
  (IHType
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool))
-> IHArg
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
-> IStepArgs
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
     t
steps Proof
  (IHType
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool))
Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
ih (SBV Integer
 -> SBV a -> SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> Symbolic (SBV Integer)
-> SymbolicT
     IO
     (SBV a -> SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Symbolic (SBV Integer)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nn SymbolicT
  IO
  (SBV a -> SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT
     IO (SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT
  IO (SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b)
-> SymbolicT IO (SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT IO (SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV c)
-> SymbolicT IO (SBV d -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nc SymbolicT IO (SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV d) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV d)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nd SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Induction over 'SInteger', taking five extra arguments
instance (KnownSymbol nn, KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b, KnownSymbol nc, SymVal c, KnownSymbol nd, SymVal d, KnownSymbol ne, SymVal e) => Inductive (Forall nn Integer -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) where
  type IHType (Forall nn Integer -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) = Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool
  type IHArg  (Forall nn Integer -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) = SInteger

  inductionStrategy :: forall t.
(Proposition
   (Forall nn Integer
    -> Forall na a
    -> Forall nb b
    -> Forall nc c
    -> Forall nd d
    -> Forall ne e
    -> SBool),
 SymVal t, EqSymbolic (SBV t)) =>
(Forall nn Integer
 -> Forall na a
 -> Forall nb b
 -> Forall nc c
 -> Forall nd d
 -> Forall ne e
 -> SBool)
-> (Proof
      (IHType
         (Forall nn Integer
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> Forall ne e
          -> SBool))
    -> IHArg
         (Forall nn Integer
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> Forall ne e
          -> SBool)
    -> IStepArgs
         (Forall nn Integer
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> Forall ne e
          -> SBool)
         t)
-> Symbolic InductionStrategy
inductionStrategy Forall nn Integer
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result Proof
  (IHType
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool))
-> IHArg
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
-> IStepArgs
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
     t
steps = do
       (SBV Integer
n, String
nn) <- Proxy nn -> Symbolic (SBV Integer, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nn)
       (SBV a
a, String
na) <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
       (SBV b
b, String
nb) <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)
       (SBV c
c, String
nc) <- Proxy nc -> Symbolic (SBV c, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)
       (SBV d
d, String
nd) <- Proxy nd -> Symbolic (SBV d, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nd)
       (SBV e
e, String
ne) <- Proxy ne -> Symbolic (SBV e, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ne)

       let bc :: SBool
bc = Forall nn Integer
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV Integer
0) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d) (SBV e -> Forall ne e
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV e
e)
           ih :: Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
ih = String
-> (Forall na a
    -> Forall nb b
    -> Forall nc c
    -> Forall nd d
    -> Forall ne e
    -> SBool)
-> Proof
     (Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) (Forall SBV c
c' :: Forall nc c) (Forall SBV d
d' :: Forall nd d) (Forall SBV e
e' :: Forall ne e) -> SBV Integer
n SBV Integer -> SBV Integer -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.>= SBV Integer
forall a. Zero a => SBV a
zero SBool -> SBool -> SBool
.=> Forall nn Integer
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV Integer
n) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b') (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c') (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d') (SBV e -> Forall ne e
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV e
e'))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof
  (IHType
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool))
-> IHArg
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
-> IStepArgs
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
     t
steps Proof
  (IHType
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool))
Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
ih SBV Integer
IHArg
  (Forall nn Integer
   -> Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
n SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e)
                     ([String] -> SBool -> SBool
indResult [String
nn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"+1", String
na, String
nb, String
nc, String
nd, String
ne] (Forall nn Integer
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result (SBV Integer -> Forall nn Integer
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV Integer
nSBV Integer -> SBV Integer -> SBV Integer
forall a. Num a => a -> a -> a
+SBV Integer
1)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d) (SBV e -> Forall ne e
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV e
e)))
                     (\[Int]
checkedLabel -> Proof
  (IHType
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool))
-> IHArg
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
-> IStepArgs
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
     t
steps Proof
  (IHType
     (Forall nn Integer
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool))
Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
ih (SBV Integer
 -> SBV a
 -> SBV b
 -> SBV c
 -> SBV d
 -> SBV e
 -> (SBool, TPProofRaw (SBV t)))
-> Symbolic (SBV Integer)
-> SymbolicT
     IO
     (SBV a
      -> SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Symbolic (SBV Integer)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nn SymbolicT
  IO
  (SBV a
   -> SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT
     IO
     (SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT
  IO
  (SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b)
-> SymbolicT
     IO (SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT
  IO (SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV c)
-> SymbolicT IO (SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nc SymbolicT IO (SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV d)
-> SymbolicT IO (SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV d)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nd SymbolicT IO (SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV e) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV e)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
ne SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- Given a user name for the list, get a name for the element, in the most suggestive way possible
--   xs  -> x
--   xss -> xs
--   foo -> fooElt
singular :: String -> String
singular :: String -> String
singular String
n = case String -> String
forall a. [a] -> [a]
reverse String
n of
               Char
's':Char
_:String
_ -> String -> String
forall a. HasCallStack => [a] -> [a]
init String
n
               String
_       -> String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Elt"

-- | Induction over 'SList'
instance (KnownSymbol nxs, SymVal x) => Inductive (Forall nxs [x] -> SBool) where
  type IHType (Forall nxs [x] -> SBool) = SBool
  type IHArg  (Forall nxs [x] -> SBool) = (SBV x, SList x)

  inductionStrategy :: forall t.
(Proposition (Forall nxs [x] -> SBool), SymVal t,
 EqSymbolic (SBV t)) =>
(Forall nxs [x] -> SBool)
-> (Proof (IHType (Forall nxs [x] -> SBool))
    -> IHArg (Forall nxs [x] -> SBool)
    -> IStepArgs (Forall nxs [x] -> SBool) t)
-> Symbolic InductionStrategy
inductionStrategy Forall nxs [x] -> SBool
result Proof (IHType (Forall nxs [x] -> SBool))
-> IHArg (Forall nxs [x] -> SBool)
-> IStepArgs (Forall nxs [x] -> SBool) t
steps = do
       (SBV x
x, SList x
xs, String
nx, String
nxs, String
nxxs) <- Proxy nxs -> Symbolic (SBV x, SList x, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nxs)

       let bc :: SBool
bc = Forall nxs [x] -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil)
           ih :: Proof SBool
ih = String -> SBool -> Proof SBool
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (Forall nxs [x] -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
xs))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof (IHType (Forall nxs [x] -> SBool))
-> IHArg (Forall nxs [x] -> SBool)
-> IStepArgs (Forall nxs [x] -> SBool) t
steps Proof SBool
Proof (IHType (Forall nxs [x] -> SBool))
ih (SBV x
x, SList x
xs))
                     ([String] -> SBool -> SBool
indResult [String
nxxs] (Forall nxs [x] -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs))))
                     (\[Int]
checkedLabel ->  ((,) (SBV x -> SList x -> (SBV x, SList x))
-> SymbolicT IO (SBV x)
-> SymbolicT IO (SList x -> (SBV x, SList x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nx SymbolicT IO (SList x -> (SBV x, SList x))
-> SymbolicT IO (SList x) -> SymbolicT IO (SBV x, SList x)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nxs) SymbolicT IO (SBV x, SList x)
-> ((SBV x, SList x) -> Symbolic SBool) -> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> ((SBV x, SList x) -> (SBool, TPProofRaw (SBV t)))
-> (SBV x, SList x)
-> Symbolic SBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof (IHType (Forall nxs [x] -> SBool))
-> IHArg (Forall nxs [x] -> SBool)
-> IStepArgs (Forall nxs [x] -> SBool) t
steps Proof SBool
Proof (IHType (Forall nxs [x] -> SBool))
ih)

-- | Induction over 'SList', taking an extra argument
instance (KnownSymbol nxs, SymVal x, KnownSymbol na, SymVal a) => Inductive (Forall nxs [x] -> Forall na a -> SBool) where
  type IHType (Forall nxs [x] -> Forall na a -> SBool) = Forall na a -> SBool
  type IHArg  (Forall nxs [x] -> Forall na a -> SBool) = (SBV x, SList x)

  inductionStrategy :: forall t.
(Proposition (Forall nxs [x] -> Forall na a -> SBool), SymVal t,
 EqSymbolic (SBV t)) =>
(Forall nxs [x] -> Forall na a -> SBool)
-> (Proof (IHType (Forall nxs [x] -> Forall na a -> SBool))
    -> IHArg (Forall nxs [x] -> Forall na a -> SBool)
    -> IStepArgs (Forall nxs [x] -> Forall na a -> SBool) t)
-> Symbolic InductionStrategy
inductionStrategy Forall nxs [x] -> Forall na a -> SBool
result Proof (IHType (Forall nxs [x] -> Forall na a -> SBool))
-> IHArg (Forall nxs [x] -> Forall na a -> SBool)
-> IStepArgs (Forall nxs [x] -> Forall na a -> SBool) t
steps = do
       (SBV x
x, SList x
xs, String
nx, String
nxs, String
nxxs) <- Proxy nxs -> Symbolic (SBV x, SList x, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nxs)
       (SBV a
a, String
na)                <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)

       let bc :: SBool
bc = Forall nxs [x] -> Forall na a -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a)
           ih :: Proof (Forall na a -> SBool)
ih = String -> (Forall na a -> SBool) -> Proof (Forall na a -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) -> Forall nxs [x] -> Forall na a -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
xs) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a'))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof (IHType (Forall nxs [x] -> Forall na a -> SBool))
-> IHArg (Forall nxs [x] -> Forall na a -> SBool)
-> IStepArgs (Forall nxs [x] -> Forall na a -> SBool) t
steps Proof (IHType (Forall nxs [x] -> Forall na a -> SBool))
Proof (Forall na a -> SBool)
ih (SBV x
x, SList x
xs) SBV a
a)
                     ([String] -> SBool -> SBool
indResult [String
nxxs, String
na] (Forall nxs [x] -> Forall na a -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a)))
                     (\[Int]
checkedLabel -> Proof (IHType (Forall nxs [x] -> Forall na a -> SBool))
-> IHArg (Forall nxs [x] -> Forall na a -> SBool)
-> IStepArgs (Forall nxs [x] -> Forall na a -> SBool) t
steps Proof (IHType (Forall nxs [x] -> Forall na a -> SBool))
Proof (Forall na a -> SBool)
ih ((SBV x, SList x) -> SBV a -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV x, SList x)
-> SymbolicT IO (SBV a -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (SBV x -> SList x -> (SBV x, SList x))
-> SymbolicT IO (SBV x)
-> SymbolicT IO (SList x -> (SBV x, SList x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nx SymbolicT IO (SList x -> (SBV x, SList x))
-> SymbolicT IO (SList x) -> SymbolicT IO (SBV x, SList x)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nxs) SymbolicT IO (SBV a -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Induction over 'SList', taking two extra arguments
instance (KnownSymbol nxs, SymVal x, KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b) => Inductive (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool) where
  type IHType (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool) = Forall na a -> Forall nb b -> SBool
  type IHArg  (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool) = (SBV x, SList x)

  inductionStrategy :: forall t.
(Proposition
   (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool),
 SymVal t, EqSymbolic (SBV t)) =>
(Forall nxs [x] -> Forall na a -> Forall nb b -> SBool)
-> (Proof
      (IHType (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool))
    -> IHArg (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool)
    -> IStepArgs
         (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool) t)
-> Symbolic InductionStrategy
inductionStrategy Forall nxs [x] -> Forall na a -> Forall nb b -> SBool
result Proof
  (IHType (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool))
-> IHArg (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool)
-> IStepArgs
     (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool) t
steps = do
       (SBV x
x, SList x
xs, String
nx, String
nxs, String
nxxs) <- Proxy nxs -> Symbolic (SBV x, SList x, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nxs)
       (SBV a
a, String
na)                <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
       (SBV b
b, String
nb)                <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)

       let bc :: SBool
bc = Forall nxs [x] -> Forall na a -> Forall nb b -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b)
           ih :: Proof (Forall na a -> Forall nb b -> SBool)
ih = String
-> (Forall na a -> Forall nb b -> SBool)
-> Proof (Forall na a -> Forall nb b -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) -> Forall nxs [x] -> Forall na a -> Forall nb b -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
xs) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b'))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof
  (IHType (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool))
-> IHArg (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool)
-> IStepArgs
     (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool) t
steps Proof
  (IHType (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool))
Proof (Forall na a -> Forall nb b -> SBool)
ih (SBV x
x, SList x
xs) SBV a
a SBV b
b)
                     ([String] -> SBool -> SBool
indResult [String
nxxs, String
na, String
nb] (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b)))
                     (\[Int]
checkedLabel -> Proof
  (IHType (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool))
-> IHArg (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool)
-> IStepArgs
     (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool) t
steps Proof
  (IHType (Forall nxs [x] -> Forall na a -> Forall nb b -> SBool))
Proof (Forall na a -> Forall nb b -> SBool)
ih ((SBV x, SList x) -> SBV a -> SBV b -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV x, SList x)
-> SymbolicT IO (SBV a -> SBV b -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (SBV x -> SList x -> (SBV x, SList x))
-> SymbolicT IO (SBV x)
-> SymbolicT IO (SList x -> (SBV x, SList x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nx SymbolicT IO (SList x -> (SBV x, SList x))
-> SymbolicT IO (SList x) -> SymbolicT IO (SBV x, SList x)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nxs) SymbolicT IO (SBV a -> SBV b -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT IO (SBV b -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT IO (SBV b -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Induction over 'SList', taking three extra arguments
instance (KnownSymbol nxs, SymVal x, KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b, KnownSymbol nc, SymVal c) => Inductive (Forall nxs [x] -> Forall na a -> Forall nb b -> Forall nc c -> SBool) where
  type IHType (Forall nxs [x] -> Forall na a -> Forall nb b -> Forall nc c -> SBool) = Forall na a -> Forall nb b -> Forall nc c -> SBool
  type IHArg  (Forall nxs [x] -> Forall na a -> Forall nb b -> Forall nc c -> SBool) = (SBV x, SList x)

  inductionStrategy :: forall t.
(Proposition
   (Forall nxs [x]
    -> Forall na a -> Forall nb b -> Forall nc c -> SBool),
 SymVal t, EqSymbolic (SBV t)) =>
(Forall nxs [x]
 -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> (Proof
      (IHType
         (Forall nxs [x]
          -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
    -> IHArg
         (Forall nxs [x]
          -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
    -> IStepArgs
         (Forall nxs [x]
          -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
         t)
-> Symbolic InductionStrategy
inductionStrategy Forall nxs [x]
-> Forall na a -> Forall nb b -> Forall nc c -> SBool
result Proof
  (IHType
     (Forall nxs [x]
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
-> IHArg
     (Forall nxs [x]
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> IStepArgs
     (Forall nxs [x]
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
     t
steps = do
       (SBV x
x, SList x
xs, String
nx, String
nxs, String
nxxs) <- Proxy nxs -> Symbolic (SBV x, SList x, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nxs)
       (SBV a
a, String
na)                <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
       (SBV b
b, String
nb)                <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)
       (SBV c
c, String
nc)                <- Proxy nc -> Symbolic (SBV c, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)

       let bc :: SBool
bc = Forall nxs [x]
-> Forall na a -> Forall nb b -> Forall nc c -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c)
           ih :: Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
ih = String
-> (Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) (Forall SBV c
c' :: Forall nc c) -> Forall nxs [x]
-> Forall na a -> Forall nb b -> Forall nc c -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
xs) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b') (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c'))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof
  (IHType
     (Forall nxs [x]
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
-> IHArg
     (Forall nxs [x]
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> IStepArgs
     (Forall nxs [x]
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
     t
steps Proof
  (IHType
     (Forall nxs [x]
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
ih (SBV x
x, SList x
xs) SBV a
a SBV b
b SBV c
c)
                     ([String] -> SBool -> SBool
indResult [String
nxxs, String
na, String
nb, String
nc] (Forall nxs [x]
-> Forall na a -> Forall nb b -> Forall nc c -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c)))
                     (\[Int]
checkedLabel -> Proof
  (IHType
     (Forall nxs [x]
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
-> IHArg
     (Forall nxs [x]
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> IStepArgs
     (Forall nxs [x]
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
     t
steps Proof
  (IHType
     (Forall nxs [x]
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
ih ((SBV x, SList x)
 -> SBV a -> SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV x, SList x)
-> SymbolicT
     IO (SBV a -> SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (SBV x -> SList x -> (SBV x, SList x))
-> SymbolicT IO (SBV x)
-> SymbolicT IO (SList x -> (SBV x, SList x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nx SymbolicT IO (SList x -> (SBV x, SList x))
-> SymbolicT IO (SList x) -> SymbolicT IO (SBV x, SList x)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nxs) SymbolicT
  IO (SBV a -> SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT IO (SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT IO (SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b)
-> SymbolicT IO (SBV c -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT IO (SBV c -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV c) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nc SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Induction over 'SList', taking four extra arguments
instance (KnownSymbol nxs, SymVal x, KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b, KnownSymbol nc, SymVal c, KnownSymbol nd, SymVal d) => Inductive (Forall nxs [x] -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool) where
  type IHType (Forall nxs [x] -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool) = Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool
  type IHArg  (Forall nxs [x] -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool) = (SBV x, SList x)

  inductionStrategy :: forall t.
(Proposition
   (Forall nxs [x]
    -> Forall na a
    -> Forall nb b
    -> Forall nc c
    -> Forall nd d
    -> SBool),
 SymVal t, EqSymbolic (SBV t)) =>
(Forall nxs [x]
 -> Forall na a
 -> Forall nb b
 -> Forall nc c
 -> Forall nd d
 -> SBool)
-> (Proof
      (IHType
         (Forall nxs [x]
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> SBool))
    -> IHArg
         (Forall nxs [x]
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> SBool)
    -> IStepArgs
         (Forall nxs [x]
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> SBool)
         t)
-> Symbolic InductionStrategy
inductionStrategy Forall nxs [x]
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> SBool
result Proof
  (IHType
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool))
-> IHArg
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
-> IStepArgs
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
     t
steps = do
       (SBV x
x, SList x
xs, String
nx, String
nxs, String
nxxs) <- Proxy nxs -> Symbolic (SBV x, SList x, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nxs)
       (SBV a
a, String
na)                <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
       (SBV b
b, String
nb)                <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)
       (SBV c
c, String
nc)                <- Proxy nc -> Symbolic (SBV c, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)
       (SBV d
d, String
nd)                <- Proxy nd -> Symbolic (SBV d, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nd)

       let bc :: SBool
bc = Forall nxs [x]
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d)
           ih :: Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
ih = String
-> (Forall na a
    -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
-> Proof
     (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) (Forall SBV c
c' :: Forall nc c) (Forall SBV d
d' :: Forall nd d) -> Forall nxs [x]
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
xs) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b') (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c') (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d'))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof
  (IHType
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool))
-> IHArg
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
-> IStepArgs
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
     t
steps Proof
  (IHType
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool))
Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
ih (SBV x
x, SList x
xs) SBV a
a SBV b
b SBV c
c SBV d
d)
                     ([String] -> SBool -> SBool
indResult [String
nxxs, String
na, String
nb, String
nc, String
nd] (Forall nxs [x]
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d)))
                     (\[Int]
checkedLabel -> Proof
  (IHType
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool))
-> IHArg
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
-> IStepArgs
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
     t
steps Proof
  (IHType
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool))
Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
ih ((SBV x, SList x)
 -> SBV a -> SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV x, SList x)
-> SymbolicT
     IO
     (SBV a -> SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (SBV x -> SList x -> (SBV x, SList x))
-> SymbolicT IO (SBV x)
-> SymbolicT IO (SList x -> (SBV x, SList x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nx SymbolicT IO (SList x -> (SBV x, SList x))
-> SymbolicT IO (SList x) -> SymbolicT IO (SBV x, SList x)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nxs) SymbolicT
  IO
  (SBV a -> SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT
     IO (SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT
  IO (SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b)
-> SymbolicT IO (SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT IO (SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV c)
-> SymbolicT IO (SBV d -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nc SymbolicT IO (SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV d) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV d)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nd SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Induction over 'SList', taking five extra arguments
instance (KnownSymbol nxs, SymVal x, KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b, KnownSymbol nc, SymVal c, KnownSymbol nd, SymVal d, KnownSymbol ne, SymVal e) => Inductive (Forall nxs [x] -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) where
  type IHType (Forall nxs [x] -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) = Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool
  type IHArg  (Forall nxs [x] -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) = (SBV x, SList x)

  inductionStrategy :: forall t.
(Proposition
   (Forall nxs [x]
    -> Forall na a
    -> Forall nb b
    -> Forall nc c
    -> Forall nd d
    -> Forall ne e
    -> SBool),
 SymVal t, EqSymbolic (SBV t)) =>
(Forall nxs [x]
 -> Forall na a
 -> Forall nb b
 -> Forall nc c
 -> Forall nd d
 -> Forall ne e
 -> SBool)
-> (Proof
      (IHType
         (Forall nxs [x]
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> Forall ne e
          -> SBool))
    -> IHArg
         (Forall nxs [x]
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> Forall ne e
          -> SBool)
    -> IStepArgs
         (Forall nxs [x]
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> Forall ne e
          -> SBool)
         t)
-> Symbolic InductionStrategy
inductionStrategy Forall nxs [x]
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result Proof
  (IHType
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool))
-> IHArg
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
-> IStepArgs
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
     t
steps = do
       (SBV x
x, SList x
xs, String
nx, String
nxs, String
nxxs) <- Proxy nxs -> Symbolic (SBV x, SList x, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nxs)
       (SBV a
a, String
na)                <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
       (SBV b
b, String
nb)                <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)
       (SBV c
c, String
nc)                <- Proxy nc -> Symbolic (SBV c, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)
       (SBV d
d, String
nd)                <- Proxy nd -> Symbolic (SBV d, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nd)
       (SBV e
e, String
ne)                <- Proxy ne -> Symbolic (SBV e, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ne)

       let bc :: SBool
bc = Forall nxs [x]
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d) (SBV e -> Forall ne e
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV e
e)
           ih :: Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
ih = String
-> (Forall na a
    -> Forall nb b
    -> Forall nc c
    -> Forall nd d
    -> Forall ne e
    -> SBool)
-> Proof
     (Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) (Forall SBV c
c' :: Forall nc c) (Forall SBV d
d' :: Forall nd d) (Forall SBV e
e' :: Forall ne e) -> Forall nxs [x]
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
xs) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b') (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c') (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d') (SBV e -> Forall ne e
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV e
e'))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof
  (IHType
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool))
-> IHArg
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
-> IStepArgs
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
     t
steps Proof
  (IHType
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool))
Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
ih (SBV x
x, SList x
xs) SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e)
                     ([String] -> SBool -> SBool
indResult [String
nxxs, String
na, String
nb, String
nc, String
nd, String
ne] (Forall nxs [x]
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d) (SBV e -> Forall ne e
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV e
e)))
                     (\[Int]
checkedLabel -> Proof
  (IHType
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool))
-> IHArg
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
-> IStepArgs
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
     t
steps Proof
  (IHType
     (Forall nxs [x]
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool))
Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
ih ((SBV x, SList x)
 -> SBV a
 -> SBV b
 -> SBV c
 -> SBV d
 -> SBV e
 -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV x, SList x)
-> SymbolicT
     IO
     (SBV a
      -> SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (SBV x -> SList x -> (SBV x, SList x))
-> SymbolicT IO (SBV x)
-> SymbolicT IO (SList x -> (SBV x, SList x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nx SymbolicT IO (SList x -> (SBV x, SList x))
-> SymbolicT IO (SList x) -> SymbolicT IO (SBV x, SList x)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nxs) SymbolicT
  IO
  (SBV a
   -> SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT
     IO
     (SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT
  IO
  (SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b)
-> SymbolicT
     IO (SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT
  IO (SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV c)
-> SymbolicT IO (SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nc SymbolicT IO (SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV d)
-> SymbolicT IO (SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV d)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nd SymbolicT IO (SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV e) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV e)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
ne SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Induction over two 'SList', simultaneously
instance (KnownSymbol nxs, SymVal x, KnownSymbol nys, SymVal y) => Inductive ((Forall nxs [x], Forall nys [y]) -> SBool) where
  type IHType ((Forall nxs [x], Forall nys [y]) -> SBool) = SBool
  type IHArg  ((Forall nxs [x], Forall nys [y]) -> SBool) = (SBV x, SList x, SBV y, SList y)

  inductionStrategy :: forall t.
(Proposition ((Forall nxs [x], Forall nys [y]) -> SBool), SymVal t,
 EqSymbolic (SBV t)) =>
((Forall nxs [x], Forall nys [y]) -> SBool)
-> (Proof (IHType ((Forall nxs [x], Forall nys [y]) -> SBool))
    -> IHArg ((Forall nxs [x], Forall nys [y]) -> SBool)
    -> IStepArgs ((Forall nxs [x], Forall nys [y]) -> SBool) t)
-> Symbolic InductionStrategy
inductionStrategy (Forall nxs [x], Forall nys [y]) -> SBool
result Proof (IHType ((Forall nxs [x], Forall nys [y]) -> SBool))
-> IHArg ((Forall nxs [x], Forall nys [y]) -> SBool)
-> IStepArgs ((Forall nxs [x], Forall nys [y]) -> SBool) t
steps = do
       (SBV x
x, SList x
xs, String
nx, String
nxs, String
nxxs) <- Proxy nxs -> Symbolic (SBV x, SList x, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nxs)
       (SBV y
y, SList y
ys, String
ny, String
nys, String
nyys) <- Proxy nys -> Symbolic (SBV y, SList y, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nys)

       let bc :: SBool
bc = (Forall nxs [x], Forall nys [y]) -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
forall a. SymVal a => SList a
SL.nil) SBool -> SBool -> SBool
.&& (Forall nxs [x], Forall nys [y]) -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV y
y SBV y -> SList y -> SList y
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList y
ys)) SBool -> SBool -> SBool
.&& (Forall nxs [x], Forall nys [y]) -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs), SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
forall a. SymVal a => SList a
SL.nil)
           ih :: Proof SBool
ih = String -> SBool -> Proof SBool
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" ((Forall nxs [x], Forall nys [y]) -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
xs, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
ys))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof (IHType ((Forall nxs [x], Forall nys [y]) -> SBool))
-> IHArg ((Forall nxs [x], Forall nys [y]) -> SBool)
-> IStepArgs ((Forall nxs [x], Forall nys [y]) -> SBool) t
steps Proof SBool
Proof (IHType ((Forall nxs [x], Forall nys [y]) -> SBool))
ih (SBV x
x, SList x
xs, SBV y
y, SList y
ys))
                     ([String] -> SBool -> SBool
indResult [String
nxxs, String
nyys] ((Forall nxs [x], Forall nys [y]) -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs), SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV y
y SBV y -> SList y -> SList y
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList y
ys))))
                     (\[Int]
checkedLabel -> ((,,,) (SBV x
 -> SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SBV x)
-> SymbolicT
     IO
     (SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nx SymbolicT
  IO
  (SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SList x)
-> SymbolicT
     IO (SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nxs SymbolicT IO (SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SBV y)
-> SymbolicT IO (SList y -> (SBV x, SList x, SBV y, SList y))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV y)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
ny SymbolicT IO (SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SList y)
-> SymbolicT IO (SBV x, SList x, SBV y, SList y)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList y)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nys) SymbolicT IO (SBV x, SList x, SBV y, SList y)
-> ((SBV x, SList x, SBV y, SList y) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> ((SBV x, SList x, SBV y, SList y)
    -> (SBool, TPProofRaw (SBV t)))
-> (SBV x, SList x, SBV y, SList y)
-> Symbolic SBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof (IHType ((Forall nxs [x], Forall nys [y]) -> SBool))
-> IHArg ((Forall nxs [x], Forall nys [y]) -> SBool)
-> IStepArgs ((Forall nxs [x], Forall nys [y]) -> SBool) t
steps Proof SBool
Proof (IHType ((Forall nxs [x], Forall nys [y]) -> SBool))
ih)

-- | Induction over two 'SList', simultaneously, taking an extra argument
instance (KnownSymbol nxs, SymVal x, KnownSymbol nys, SymVal y, KnownSymbol na, SymVal a) => Inductive ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool) where
  type IHType ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool) = Forall na a -> SBool
  type IHArg  ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool) = (SBV x, SList x, SBV y, SList y)

  inductionStrategy :: forall t.
(Proposition
   ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool),
 SymVal t, EqSymbolic (SBV t)) =>
((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool)
-> (Proof
      (IHType ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool))
    -> IHArg ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool)
    -> IStepArgs
         ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool) t)
-> Symbolic InductionStrategy
inductionStrategy (Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool
result Proof
  (IHType ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool))
-> IHArg ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool)
-> IStepArgs
     ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool) t
steps = do
       (SBV x
x, SList x
xs, String
nx, String
nxs, String
nxxs) <- Proxy nxs -> Symbolic (SBV x, SList x, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nxs)
       (SBV y
y, SList y
ys, String
ny, String
nys, String
nyys) <- Proxy nys -> Symbolic (SBV y, SList y, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nys)
       (SBV a
a, String
na)                <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)

       let bc :: SBool
bc = (Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
forall a. SymVal a => SList a
SL.nil) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) SBool -> SBool -> SBool
.&& (Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV y
y SBV y -> SList y -> SList y
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList y
ys)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) SBool -> SBool -> SBool
.&& (Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs), SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
forall a. SymVal a => SList a
SL.nil) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a)
           ih :: Proof (Forall na a -> SBool)
ih = String -> (Forall na a -> SBool) -> Proof (Forall na a -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) -> (Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
xs, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
ys) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a'))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof
  (IHType ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool))
-> IHArg ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool)
-> IStepArgs
     ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool) t
steps Proof
  (IHType ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool))
Proof (Forall na a -> SBool)
ih (SBV x
x, SList x
xs, SBV y
y, SList y
ys) SBV a
a)
                     ([String] -> SBool -> SBool
indResult [String
nxxs, String
nyys, String
na] ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs), SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV y
y SBV y -> SList y -> SList y
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList y
ys)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a)))
                     (\[Int]
checkedLabel -> Proof
  (IHType ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool))
-> IHArg ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool)
-> IStepArgs
     ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool) t
steps Proof
  (IHType ((Forall nxs [x], Forall nys [y]) -> Forall na a -> SBool))
Proof (Forall na a -> SBool)
ih ((SBV x, SList x, SBV y, SList y)
 -> SBV a -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV x, SList x, SBV y, SList y)
-> SymbolicT IO (SBV a -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,,,) (SBV x
 -> SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SBV x)
-> SymbolicT
     IO
     (SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nx SymbolicT
  IO
  (SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SList x)
-> SymbolicT
     IO (SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nxs SymbolicT IO (SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SBV y)
-> SymbolicT IO (SList y -> (SBV x, SList x, SBV y, SList y))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV y)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
ny SymbolicT IO (SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SList y)
-> SymbolicT IO (SBV x, SList x, SBV y, SList y)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList y)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nys) SymbolicT IO (SBV a -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Induction over two 'SList', simultaneously, taking two extra arguments
instance (KnownSymbol nxs, SymVal x, KnownSymbol nys, SymVal y, KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b) => Inductive ((Forall nxs [x], Forall nys [y]) -> Forall na a -> Forall nb b -> SBool) where
  type IHType ((Forall nxs [x], Forall nys [y]) -> Forall na a -> Forall nb b -> SBool) = Forall na a -> Forall nb b -> SBool
  type IHArg  ((Forall nxs [x], Forall nys [y]) -> Forall na a -> Forall nb b -> SBool) = (SBV x, SList x, SBV y, SList y)

  inductionStrategy :: forall t.
(Proposition
   ((Forall nxs [x], Forall nys [y])
    -> Forall na a -> Forall nb b -> SBool),
 SymVal t, EqSymbolic (SBV t)) =>
((Forall nxs [x], Forall nys [y])
 -> Forall na a -> Forall nb b -> SBool)
-> (Proof
      (IHType
         ((Forall nxs [x], Forall nys [y])
          -> Forall na a -> Forall nb b -> SBool))
    -> IHArg
         ((Forall nxs [x], Forall nys [y])
          -> Forall na a -> Forall nb b -> SBool)
    -> IStepArgs
         ((Forall nxs [x], Forall nys [y])
          -> Forall na a -> Forall nb b -> SBool)
         t)
-> Symbolic InductionStrategy
inductionStrategy (Forall nxs [x], Forall nys [y])
-> Forall na a -> Forall nb b -> SBool
result Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> SBool))
-> IHArg
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> SBool)
-> IStepArgs
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> SBool)
     t
steps = do
       (SBV x
x, SList x
xs, String
nx, String
nxs, String
nxxs) <- Proxy nxs -> Symbolic (SBV x, SList x, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nxs)
       (SBV y
y, SList y
ys, String
ny, String
nys, String
nyys) <- Proxy nys -> Symbolic (SBV y, SList y, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nys)
       (SBV a
a, String
na)                <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
       (SBV b
b, String
nb)                <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)

       let bc :: SBool
bc = (Forall nxs [x], Forall nys [y])
-> Forall na a -> Forall nb b -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
forall a. SymVal a => SList a
SL.nil) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) SBool -> SBool -> SBool
.&& (Forall nxs [x], Forall nys [y])
-> Forall na a -> Forall nb b -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV y
y SBV y -> SList y -> SList y
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList y
ys)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) SBool -> SBool -> SBool
.&& (Forall nxs [x], Forall nys [y])
-> Forall na a -> Forall nb b -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs), SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
forall a. SymVal a => SList a
SL.nil) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b)
           ih :: Proof (Forall na a -> Forall nb b -> SBool)
ih = String
-> (Forall na a -> Forall nb b -> SBool)
-> Proof (Forall na a -> Forall nb b -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) -> (Forall nxs [x], Forall nys [y])
-> Forall na a -> Forall nb b -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
xs, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
ys) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b'))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> SBool))
-> IHArg
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> SBool)
-> IStepArgs
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> SBool)
     t
steps Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> SBool))
Proof (Forall na a -> Forall nb b -> SBool)
ih (SBV x
x, SList x
xs, SBV y
y, SList y
ys) SBV a
a SBV b
b)
                     ([String] -> SBool -> SBool
indResult [String
nxxs, String
nyys, String
na, String
nb] ((Forall nxs [x], Forall nys [y])
-> Forall na a -> Forall nb b -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs), SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV y
y SBV y -> SList y -> SList y
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList y
ys)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b)))
                     (\[Int]
checkedLabel -> Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> SBool))
-> IHArg
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> SBool)
-> IStepArgs
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> SBool)
     t
steps Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> SBool))
Proof (Forall na a -> Forall nb b -> SBool)
ih ((SBV x, SList x, SBV y, SList y)
 -> SBV a -> SBV b -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV x, SList x, SBV y, SList y)
-> SymbolicT IO (SBV a -> SBV b -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,,,) (SBV x
 -> SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SBV x)
-> SymbolicT
     IO
     (SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nx SymbolicT
  IO
  (SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SList x)
-> SymbolicT
     IO (SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nxs SymbolicT IO (SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SBV y)
-> SymbolicT IO (SList y -> (SBV x, SList x, SBV y, SList y))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV y)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
ny SymbolicT IO (SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SList y)
-> SymbolicT IO (SBV x, SList x, SBV y, SList y)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList y)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nys) SymbolicT IO (SBV a -> SBV b -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT IO (SBV b -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT IO (SBV b -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Induction over two 'SList', simultaneously, taking three extra arguments
instance (KnownSymbol nxs, SymVal x, KnownSymbol nys, SymVal y, KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b, KnownSymbol nc, SymVal c) => Inductive ((Forall nxs [x], Forall nys [y]) -> Forall na a -> Forall nb b -> Forall nc c -> SBool) where
  type IHType ((Forall nxs [x], Forall nys [y]) -> Forall na a -> Forall nb b -> Forall nc c -> SBool) = Forall na a -> Forall nb b -> Forall nc c -> SBool
  type IHArg  ((Forall nxs [x], Forall nys [y]) -> Forall na a -> Forall nb b -> Forall nc c -> SBool) = (SBV x, SList x, SBV y, SList y)

  inductionStrategy :: forall t.
(Proposition
   ((Forall nxs [x], Forall nys [y])
    -> Forall na a -> Forall nb b -> Forall nc c -> SBool),
 SymVal t, EqSymbolic (SBV t)) =>
((Forall nxs [x], Forall nys [y])
 -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> (Proof
      (IHType
         ((Forall nxs [x], Forall nys [y])
          -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
    -> IHArg
         ((Forall nxs [x], Forall nys [y])
          -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
    -> IStepArgs
         ((Forall nxs [x], Forall nys [y])
          -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
         t)
-> Symbolic InductionStrategy
inductionStrategy (Forall nxs [x], Forall nys [y])
-> Forall na a -> Forall nb b -> Forall nc c -> SBool
result Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
-> IHArg
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> IStepArgs
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
     t
steps = do
       (SBV x
x, SList x
xs, String
nx, String
nxs, String
nxxs) <- Proxy nxs -> Symbolic (SBV x, SList x, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nxs)
       (SBV y
y, SList y
ys, String
ny, String
nys, String
nyys) <- Proxy nys -> Symbolic (SBV y, SList y, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nys)
       (SBV a
a, String
na)                <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
       (SBV b
b, String
nb)                <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)
       (SBV c
c, String
nc)                <- Proxy nc -> Symbolic (SBV c, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)

       let bc :: SBool
bc = (Forall nxs [x], Forall nys [y])
-> Forall na a -> Forall nb b -> Forall nc c -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
forall a. SymVal a => SList a
SL.nil) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) SBool -> SBool -> SBool
.&& (Forall nxs [x], Forall nys [y])
-> Forall na a -> Forall nb b -> Forall nc c -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV y
y SBV y -> SList y -> SList y
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList y
ys)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) SBool -> SBool -> SBool
.&& (Forall nxs [x], Forall nys [y])
-> Forall na a -> Forall nb b -> Forall nc c -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs), SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
forall a. SymVal a => SList a
SL.nil) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c)
           ih :: Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
ih = String
-> (Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) (Forall SBV c
c' :: Forall nc c) -> (Forall nxs [x], Forall nys [y])
-> Forall na a -> Forall nb b -> Forall nc c -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
xs, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
ys) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b') (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c'))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
-> IHArg
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> IStepArgs
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
     t
steps Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
ih (SBV x
x, SList x
xs, SBV y
y, SList y
ys) SBV a
a SBV b
b SBV c
c)
                     ([String] -> SBool -> SBool
indResult [String
nxxs, String
nyys, String
na, String
nb, String
nc] ((Forall nxs [x], Forall nys [y])
-> Forall na a -> Forall nb b -> Forall nc c -> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs), SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV y
y SBV y -> SList y -> SList y
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList y
ys)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c)))
                     (\[Int]
checkedLabel -> Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
-> IHArg
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> IStepArgs
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool)
     t
steps Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a -> Forall nb b -> Forall nc c -> SBool))
Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
ih ((SBV x, SList x, SBV y, SList y)
 -> SBV a -> SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV x, SList x, SBV y, SList y)
-> SymbolicT
     IO (SBV a -> SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,,,) (SBV x
 -> SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SBV x)
-> SymbolicT
     IO
     (SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nx SymbolicT
  IO
  (SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SList x)
-> SymbolicT
     IO (SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nxs SymbolicT IO (SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SBV y)
-> SymbolicT IO (SList y -> (SBV x, SList x, SBV y, SList y))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV y)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
ny SymbolicT IO (SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SList y)
-> SymbolicT IO (SBV x, SList x, SBV y, SList y)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList y)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nys) SymbolicT
  IO (SBV a -> SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT IO (SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT IO (SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b)
-> SymbolicT IO (SBV c -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT IO (SBV c -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV c) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nc SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Induction over two 'SList', simultaneously, taking four extra arguments
instance (KnownSymbol nxs, SymVal x, KnownSymbol nys, SymVal y, KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b, KnownSymbol nc, SymVal c, KnownSymbol nd, SymVal d) => Inductive ((Forall nxs [x], Forall nys [y]) -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool) where
  type IHType ((Forall nxs [x], Forall nys [y]) -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool) = Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool
  type IHArg  ((Forall nxs [x], Forall nys [y]) -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool) = (SBV x, SList x, SBV y, SList y)

  inductionStrategy :: forall t.
(Proposition
   ((Forall nxs [x], Forall nys [y])
    -> Forall na a
    -> Forall nb b
    -> Forall nc c
    -> Forall nd d
    -> SBool),
 SymVal t, EqSymbolic (SBV t)) =>
((Forall nxs [x], Forall nys [y])
 -> Forall na a
 -> Forall nb b
 -> Forall nc c
 -> Forall nd d
 -> SBool)
-> (Proof
      (IHType
         ((Forall nxs [x], Forall nys [y])
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> SBool))
    -> IHArg
         ((Forall nxs [x], Forall nys [y])
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> SBool)
    -> IStepArgs
         ((Forall nxs [x], Forall nys [y])
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> SBool)
         t)
-> Symbolic InductionStrategy
inductionStrategy (Forall nxs [x], Forall nys [y])
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> SBool
result Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool))
-> IHArg
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
-> IStepArgs
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
     t
steps = do
       (SBV x
x, SList x
xs, String
nx, String
nxs, String
nxxs) <- Proxy nxs -> Symbolic (SBV x, SList x, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nxs)
       (SBV y
y, SList y
ys, String
ny, String
nys, String
nyys) <- Proxy nys -> Symbolic (SBV y, SList y, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nys)
       (SBV a
a, String
na)                <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
       (SBV b
b, String
nb)                <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)
       (SBV c
c, String
nc)                <- Proxy nc -> Symbolic (SBV c, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)
       (SBV d
d, String
nd)                <- Proxy nd -> Symbolic (SBV d, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nd)

       let bc :: SBool
bc = (Forall nxs [x], Forall nys [y])
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
forall a. SymVal a => SList a
SL.nil) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d) SBool -> SBool -> SBool
.&& (Forall nxs [x], Forall nys [y])
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV y
y SBV y -> SList y -> SList y
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList y
ys)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d) SBool -> SBool -> SBool
.&& (Forall nxs [x], Forall nys [y])
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs), SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
forall a. SymVal a => SList a
SL.nil) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d)
           ih :: Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
ih = String
-> (Forall na a
    -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
-> Proof
     (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) (Forall SBV c
c' :: Forall nc c) (Forall SBV d
d' :: Forall nd d) -> (Forall nxs [x], Forall nys [y])
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
xs, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
ys) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b') (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c') (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d'))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool))
-> IHArg
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
-> IStepArgs
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
     t
steps Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool))
Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
ih (SBV x
x, SList x
xs, SBV y
y, SList y
ys) SBV a
a SBV b
b SBV c
c SBV d
d)
                     ([String] -> SBool -> SBool
indResult [String
nxxs, String
nyys, String
na, String
nb, String
nc, String
nd] ((Forall nxs [x], Forall nys [y])
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs), SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV y
y SBV y -> SList y -> SList y
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList y
ys)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d)))
                     (\[Int]
checkedLabel -> Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool))
-> IHArg
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
-> IStepArgs
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool)
     t
steps Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> SBool))
Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
ih ((SBV x, SList x, SBV y, SList y)
 -> SBV a -> SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV x, SList x, SBV y, SList y)
-> SymbolicT
     IO
     (SBV a -> SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,,,) (SBV x
 -> SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SBV x)
-> SymbolicT
     IO
     (SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nx SymbolicT
  IO
  (SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SList x)
-> SymbolicT
     IO (SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nxs SymbolicT IO (SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SBV y)
-> SymbolicT IO (SList y -> (SBV x, SList x, SBV y, SList y))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV y)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
ny SymbolicT IO (SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SList y)
-> SymbolicT IO (SBV x, SList x, SBV y, SList y)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList y)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nys) SymbolicT
  IO
  (SBV a -> SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT
     IO (SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT
  IO (SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b)
-> SymbolicT IO (SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT IO (SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV c)
-> SymbolicT IO (SBV d -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nc SymbolicT IO (SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV d) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV d)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nd SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Induction over two 'SList', simultaneously, taking five extra arguments
instance (KnownSymbol nxs, SymVal x, KnownSymbol nys, SymVal y, KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b, KnownSymbol nc, SymVal c, KnownSymbol nd, SymVal d, KnownSymbol ne, SymVal e) => Inductive ((Forall nxs [x], Forall nys [y]) -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) where
  type IHType ((Forall nxs [x], Forall nys [y]) -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) = Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool
  type IHArg  ((Forall nxs [x], Forall nys [y]) -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) = (SBV x, SList x, SBV y, SList y)

  inductionStrategy :: forall t.
(Proposition
   ((Forall nxs [x], Forall nys [y])
    -> Forall na a
    -> Forall nb b
    -> Forall nc c
    -> Forall nd d
    -> Forall ne e
    -> SBool),
 SymVal t, EqSymbolic (SBV t)) =>
((Forall nxs [x], Forall nys [y])
 -> Forall na a
 -> Forall nb b
 -> Forall nc c
 -> Forall nd d
 -> Forall ne e
 -> SBool)
-> (Proof
      (IHType
         ((Forall nxs [x], Forall nys [y])
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> Forall ne e
          -> SBool))
    -> IHArg
         ((Forall nxs [x], Forall nys [y])
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> Forall ne e
          -> SBool)
    -> IStepArgs
         ((Forall nxs [x], Forall nys [y])
          -> Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> Forall ne e
          -> SBool)
         t)
-> Symbolic InductionStrategy
inductionStrategy (Forall nxs [x], Forall nys [y])
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool))
-> IHArg
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
-> IStepArgs
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
     t
steps = do
       (SBV x
x, SList x
xs, String
nx, String
nxs, String
nxxs) <- Proxy nxs -> Symbolic (SBV x, SList x, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nxs)
       (SBV y
y, SList y
ys, String
ny, String
nys, String
nyys) <- Proxy nys -> Symbolic (SBV y, SList y, String, String, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, SList a, String, String, String)
mkLVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nys)
       (SBV a
a, String
na)                <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
       (SBV b
b, String
nb)                <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)
       (SBV c
c, String
nc)                <- Proxy nc -> Symbolic (SBV c, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)
       (SBV d
d, String
nd)                <- Proxy nd -> Symbolic (SBV d, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nd)
       (SBV e
e, String
ne)                <- Proxy ne -> Symbolic (SBV e, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar  (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ne)

       let bc :: SBool
bc = (Forall nxs [x], Forall nys [y])
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
forall a. SymVal a => SList a
SL.nil) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d) (SBV e -> Forall ne e
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV e
e) SBool -> SBool -> SBool
.&& (Forall nxs [x], Forall nys [y])
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
forall a. SymVal a => SList a
SL.nil, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV y
y SBV y -> SList y -> SList y
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList y
ys)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d) (SBV e -> Forall ne e
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV e
e) SBool -> SBool -> SBool
.&& (Forall nxs [x], Forall nys [y])
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs), SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
forall a. SymVal a => SList a
SL.nil) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d) (SBV e -> Forall ne e
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV e
e)
           ih :: Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
ih = String
-> (Forall na a
    -> Forall nb b
    -> Forall nc c
    -> Forall nd d
    -> Forall ne e
    -> SBool)
-> Proof
     (Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) (Forall SBV c
c' :: Forall nc c) (Forall SBV d
d' :: Forall nd d) (Forall SBV e
e' :: Forall ne e) -> (Forall nxs [x], Forall nys [y])
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList x
xs, SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SList y
ys) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b') (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c') (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d') (SBV e -> Forall ne e
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV e
e'))

       Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy Maybe SBool
forall a. Maybe a
Nothing
                     (SBool -> Maybe SBool
forall a. a -> Maybe a
Just SBool
bc)
                     (Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool))
-> IHArg
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
-> IStepArgs
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
     t
steps Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool))
Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
ih (SBV x
x, SList x
xs, SBV y
y, SList y
ys) SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e)
                     ([String] -> SBool -> SBool
indResult [String
nxxs, String
nyys, String
na, String
nb, String
nc, String
nd, String
ne] ((Forall nxs [x], Forall nys [y])
-> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result (SList x -> Forall nxs [x]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV x
x SBV x -> SList x -> SList x
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList x
xs), SList y -> Forall nys [y]
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV y
y SBV y -> SList y -> SList y
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList y
ys)) (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d) (SBV e -> Forall ne e
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV e
e)))
                     (\[Int]
checkedLabel -> Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool))
-> IHArg
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
-> IStepArgs
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
     t
steps Proof
  (IHType
     ((Forall nxs [x], Forall nys [y])
      -> Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool))
Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
ih ((SBV x, SList x, SBV y, SList y)
 -> SBV a
 -> SBV b
 -> SBV c
 -> SBV d
 -> SBV e
 -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV x, SList x, SBV y, SList y)
-> SymbolicT
     IO
     (SBV a
      -> SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,,,) (SBV x
 -> SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SBV x)
-> SymbolicT
     IO
     (SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nx SymbolicT
  IO
  (SList x -> SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SList x)
-> SymbolicT
     IO (SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList x)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nxs SymbolicT IO (SBV y -> SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SBV y)
-> SymbolicT IO (SList y -> (SBV x, SList x, SBV y, SList y))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV y)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
ny SymbolicT IO (SList y -> (SBV x, SList x, SBV y, SList y))
-> SymbolicT IO (SList y)
-> SymbolicT IO (SBV x, SList x, SBV y, SList y)
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SList y)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nys) SymbolicT
  IO
  (SBV a
   -> SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT
     IO
     (SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT
  IO
  (SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b)
-> SymbolicT
     IO (SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT
  IO (SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV c)
-> SymbolicT IO (SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nc SymbolicT IO (SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV d)
-> SymbolicT IO (SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV d)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nd SymbolicT IO (SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV e) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV e)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
ne SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Generalized induction with one parameter
instance (KnownSymbol na, SymVal a) => SInductive (Forall na a -> SBool) where
  sInductionStrategy :: forall m t.
(Proposition (Forall na a -> SBool), Zero m, SymVal t,
 EqSymbolic (SBV t)) =>
(Forall na a -> SBool)
-> MeasureArgs (Forall na a -> SBool) m
-> (Proof (Forall na a -> SBool)
    -> StepArgs (Forall na a -> SBool) t)
-> Symbolic InductionStrategy
sInductionStrategy Forall na a -> SBool
result MeasureArgs (Forall na a -> SBool) m
measure Proof (Forall na a -> SBool) -> StepArgs (Forall na a -> SBool) t
steps = do
      (SBV a
a, String
na) <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)

      let ih :: Proof (Forall na a -> SBool)
ih   = String -> (Forall na a -> SBool) -> Proof (Forall na a -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) -> MeasureArgs (Forall na a -> SBool) m
SBV a -> SBV m
measure SBV a
a' SBV m -> SBV m -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< MeasureArgs (Forall na a -> SBool) m
SBV a -> SBV m
measure SBV a
a SBool -> SBool -> SBool
.=> Forall na a -> SBool
result (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a'))
          conc :: SBool
conc = Forall na a -> SBool
result (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a)

      Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy (SBool -> Maybe SBool
forall a. a -> Maybe a
Just (MeasureArgs (Forall na a -> SBool) m
SBV a -> SBV m
measure SBV a
a SBV m -> SBV m -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.>= SBV m
forall a. Zero a => SBV a
zero))
                    Maybe SBool
forall a. Maybe a
Nothing
                    (Proof (Forall na a -> SBool) -> StepArgs (Forall na a -> SBool) t
steps Proof (Forall na a -> SBool)
ih SBV a
a)
                    ([String] -> SBool -> SBool
indResult [String
na] SBool
conc)
                    (\[Int]
checkedLabel -> String -> Symbolic (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na Symbolic (SBV a) -> (SBV a -> Symbolic SBool) -> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> (SBV a -> (SBool, TPProofRaw (SBV t)))
-> SBV a
-> Symbolic SBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof (Forall na a -> SBool) -> StepArgs (Forall na a -> SBool) t
steps Proof (Forall na a -> SBool)
ih)

-- | Generalized induction with two parameters
instance (KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b) => SInductive (Forall na a -> Forall nb b -> SBool) where
  sInductionStrategy :: forall m t.
(Proposition (Forall na a -> Forall nb b -> SBool), Zero m,
 SymVal t, EqSymbolic (SBV t)) =>
(Forall na a -> Forall nb b -> SBool)
-> MeasureArgs (Forall na a -> Forall nb b -> SBool) m
-> (Proof (Forall na a -> Forall nb b -> SBool)
    -> StepArgs (Forall na a -> Forall nb b -> SBool) t)
-> Symbolic InductionStrategy
sInductionStrategy Forall na a -> Forall nb b -> SBool
result MeasureArgs (Forall na a -> Forall nb b -> SBool) m
measure Proof (Forall na a -> Forall nb b -> SBool)
-> StepArgs (Forall na a -> Forall nb b -> SBool) t
steps = do
      (SBV a
a, String
na) <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
      (SBV b
b, String
nb) <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)

      let ih :: Proof (Forall na a -> Forall nb b -> SBool)
ih   = String
-> (Forall na a -> Forall nb b -> SBool)
-> Proof (Forall na a -> Forall nb b -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) -> MeasureArgs (Forall na a -> Forall nb b -> SBool) m
SBV a -> SBV b -> SBV m
measure SBV a
a' SBV b
b' SBV m -> SBV m -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< MeasureArgs (Forall na a -> Forall nb b -> SBool) m
SBV a -> SBV b -> SBV m
measure SBV a
a SBV b
b SBool -> SBool -> SBool
.=> Forall na a -> Forall nb b -> SBool
result (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b'))
          conc :: SBool
conc = Forall na a -> Forall nb b -> SBool
result (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b)

      Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy (SBool -> Maybe SBool
forall a. a -> Maybe a
Just (MeasureArgs (Forall na a -> Forall nb b -> SBool) m
SBV a -> SBV b -> SBV m
measure SBV a
a SBV b
b SBV m -> SBV m -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.>= SBV m
forall a. Zero a => SBV a
zero))
                    Maybe SBool
forall a. Maybe a
Nothing
                    (Proof (Forall na a -> Forall nb b -> SBool)
-> StepArgs (Forall na a -> Forall nb b -> SBool) t
steps Proof (Forall na a -> Forall nb b -> SBool)
ih SBV a
a SBV b
b)
                    ([String] -> SBool -> SBool
indResult [String
na, String
nb] SBool
conc)
                    (\[Int]
checkedLabel -> Proof (Forall na a -> Forall nb b -> SBool)
-> StepArgs (Forall na a -> Forall nb b -> SBool) t
steps Proof (Forall na a -> Forall nb b -> SBool)
ih (SBV a -> SBV b -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT IO (SBV b -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT IO (SBV b -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Generalized induction with three parameters
instance (KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b, KnownSymbol nc, SymVal c) => SInductive (Forall na a -> Forall nb b -> Forall nc c -> SBool) where
  sInductionStrategy :: forall m t.
(Proposition (Forall na a -> Forall nb b -> Forall nc c -> SBool),
 Zero m, SymVal t, EqSymbolic (SBV t)) =>
(Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> MeasureArgs
     (Forall na a -> Forall nb b -> Forall nc c -> SBool) m
-> (Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
    -> StepArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool) t)
-> Symbolic InductionStrategy
sInductionStrategy Forall na a -> Forall nb b -> Forall nc c -> SBool
result MeasureArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool) m
measure Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> StepArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool) t
steps = do
      (SBV a
a, String
na) <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
      (SBV b
b, String
nb) <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)
      (SBV c
c, String
nc) <- Proxy nc -> Symbolic (SBV c, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)

      let ih :: Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
ih   = String
-> (Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) (Forall SBV c
c' :: Forall nc c) -> MeasureArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool) m
SBV a -> SBV b -> SBV c -> SBV m
measure SBV a
a' SBV b
b' SBV c
c' SBV m -> SBV m -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< MeasureArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool) m
SBV a -> SBV b -> SBV c -> SBV m
measure SBV a
a SBV b
b SBV c
c SBool -> SBool -> SBool
.=> Forall na a -> Forall nb b -> Forall nc c -> SBool
result (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b') (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c'))
          conc :: SBool
conc = Forall na a -> Forall nb b -> Forall nc c -> SBool
result (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c)

      Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy (SBool -> Maybe SBool
forall a. a -> Maybe a
Just (MeasureArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool) m
SBV a -> SBV b -> SBV c -> SBV m
measure SBV a
a SBV b
b SBV c
c SBV m -> SBV m -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.>= SBV m
forall a. Zero a => SBV a
zero))
                    Maybe SBool
forall a. Maybe a
Nothing
                    (Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> StepArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool) t
steps Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
ih SBV a
a SBV b
b SBV c
c)
                    ([String] -> SBool -> SBool
indResult [String
na, String
nb, String
nc] SBool
conc)
                    (\[Int]
checkedLabel -> Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> StepArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool) t
steps Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
ih (SBV a -> SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT IO (SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT IO (SBV b -> SBV c -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b)
-> SymbolicT IO (SBV c -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT IO (SBV c -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV c) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nc SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Generalized induction with four parameters
instance (KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b, KnownSymbol nc, SymVal c, KnownSymbol nd, SymVal d) => SInductive (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool) where
  sInductionStrategy :: forall m t.
(Proposition
   (Forall na a
    -> Forall nb b -> Forall nc c -> Forall nd d -> SBool),
 Zero m, SymVal t, EqSymbolic (SBV t)) =>
(Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
-> MeasureArgs
     (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
     m
-> (Proof
      (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
    -> StepArgs
         (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
         t)
-> Symbolic InductionStrategy
sInductionStrategy Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool
result MeasureArgs
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
  m
measure Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
-> StepArgs
     (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
     t
steps = do
      (SBV a
a, String
na) <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
      (SBV b
b, String
nb) <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)
      (SBV c
c, String
nc) <- Proxy nc -> Symbolic (SBV c, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)
      (SBV d
d, String
nd) <- Proxy nd -> Symbolic (SBV d, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nd)

      let ih :: Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
ih   = String
-> (Forall na a
    -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
-> Proof
     (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) (Forall SBV c
c' :: Forall nc c) (Forall SBV d
d' :: Forall nd d) -> MeasureArgs
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
  m
SBV a -> SBV b -> SBV c -> SBV d -> SBV m
measure SBV a
a' SBV b
b' SBV c
c' SBV d
d' SBV m -> SBV m -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< MeasureArgs
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
  m
SBV a -> SBV b -> SBV c -> SBV d -> SBV m
measure SBV a
a SBV b
b SBV c
c SBV d
d SBool -> SBool -> SBool
.=> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool
result (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b') (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c') (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d'))
          conc :: SBool
conc = Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool
result (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d)

      Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy (SBool -> Maybe SBool
forall a. a -> Maybe a
Just (MeasureArgs
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
  m
SBV a -> SBV b -> SBV c -> SBV d -> SBV m
measure SBV a
a SBV b
b SBV c
c SBV d
d SBV m -> SBV m -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.>= SBV m
forall a. Zero a => SBV a
zero))
                    Maybe SBool
forall a. Maybe a
Nothing
                    (Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
-> StepArgs
     (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
     t
steps Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
ih SBV a
a SBV b
b SBV c
c SBV d
d)
                    ([String] -> SBool -> SBool
indResult [String
na, String
nb, String
nc, String
nd] SBool
conc)
                    (\[Int]
checkedLabel -> Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
-> StepArgs
     (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
     t
steps Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
ih (SBV a -> SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT
     IO (SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT
  IO (SBV b -> SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b)
-> SymbolicT IO (SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT IO (SBV c -> SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV c)
-> SymbolicT IO (SBV d -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nc SymbolicT IO (SBV d -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV d) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV d)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nd SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Generalized induction with five parameters
instance (KnownSymbol na, SymVal a, KnownSymbol nb, SymVal b, KnownSymbol nc, SymVal c, KnownSymbol nd, SymVal d, KnownSymbol ne, SymVal e) => SInductive (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) where
  sInductionStrategy :: forall m t.
(Proposition
   (Forall na a
    -> Forall nb b
    -> Forall nc c
    -> Forall nd d
    -> Forall ne e
    -> SBool),
 Zero m, SymVal t, EqSymbolic (SBV t)) =>
(Forall na a
 -> Forall nb b
 -> Forall nc c
 -> Forall nd d
 -> Forall ne e
 -> SBool)
-> MeasureArgs
     (Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
     m
-> (Proof
      (Forall na a
       -> Forall nb b
       -> Forall nc c
       -> Forall nd d
       -> Forall ne e
       -> SBool)
    -> StepArgs
         (Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> Forall ne e
          -> SBool)
         t)
-> Symbolic InductionStrategy
sInductionStrategy Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result MeasureArgs
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
  m
measure Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
-> StepArgs
     (Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
     t
steps = do
      (SBV a
a, String
na) <- Proxy na -> Symbolic (SBV a, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @na)
      (SBV b
b, String
nb) <- Proxy nb -> Symbolic (SBV b, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nb)
      (SBV c
c, String
nc) <- Proxy nc -> Symbolic (SBV c, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nc)
      (SBV d
d, String
nd) <- Proxy nd -> Symbolic (SBV d, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nd)
      (SBV e
e, String
ne) <- Proxy ne -> Symbolic (SBV e, String)
forall (n :: Symbol) a (proxy :: Symbol -> *).
(KnownSymbol n, SymVal a) =>
proxy n -> Symbolic (SBV a, String)
mkVar (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ne)

      let ih :: Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
ih   = String
-> (Forall na a
    -> Forall nb b
    -> Forall nc c
    -> Forall nd d
    -> Forall ne e
    -> SBool)
-> Proof
     (Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
forall a. Proposition a => String -> a -> Proof a
internalAxiom String
"IH" (\(Forall SBV a
a' :: Forall na a) (Forall SBV b
b' :: Forall nb b) (Forall SBV c
c' :: Forall nc c) (Forall SBV d
d' :: Forall nd d) (Forall SBV e
e' :: Forall ne e) -> MeasureArgs
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
  m
SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV m
measure SBV a
a' SBV b
b' SBV c
c' SBV d
d' SBV e
e' SBV m -> SBV m -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< MeasureArgs
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
  m
SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV m
measure SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBool -> SBool -> SBool
.=> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a') (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b') (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c') (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d') (SBV e -> Forall ne e
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV e
e'))
          conc :: SBool
conc = Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
result (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d) (SBV e -> Forall ne e
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV e
e)

      Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV t))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
forall a.
(SymVal a, EqSymbolic (SBV a)) =>
Maybe SBool
-> Maybe SBool
-> (SBool, TPProofRaw (SBV a))
-> SBool
-> ([Int] -> Symbolic SBool)
-> Symbolic InductionStrategy
mkIndStrategy (SBool -> Maybe SBool
forall a. a -> Maybe a
Just (MeasureArgs
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
  m
SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV m
measure SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV m -> SBV m -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.>= SBV m
forall a. Zero a => SBV a
zero))
                    Maybe SBool
forall a. Maybe a
Nothing
                    (Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
-> StepArgs
     (Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
     t
steps Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
ih SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e)
                    ([String] -> SBool -> SBool
indResult [String
na, String
nb, String
nc, String
nd, String
ne] SBool
conc)
                    (\[Int]
checkedLabel -> Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
-> StepArgs
     (Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
     t
steps Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
ih (SBV a
 -> SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV a)
-> SymbolicT
     IO
     (SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SymbolicT IO (SBV a)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
na SymbolicT
  IO
  (SBV b -> SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV b)
-> SymbolicT
     IO (SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV b)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nb SymbolicT
  IO (SBV c -> SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV c)
-> SymbolicT IO (SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV c)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nc SymbolicT IO (SBV d -> SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV d)
-> SymbolicT IO (SBV e -> (SBool, TPProofRaw (SBV t)))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV d)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
nd SymbolicT IO (SBV e -> (SBool, TPProofRaw (SBV t)))
-> SymbolicT IO (SBV e) -> SymbolicT IO (SBool, TPProofRaw (SBV t))
forall a b.
SymbolicT IO (a -> b) -> SymbolicT IO a -> SymbolicT IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> SymbolicT IO (SBV e)
forall a. SymVal a => String -> Symbolic (SBV a)
free String
ne SymbolicT IO (SBool, TPProofRaw (SBV t))
-> ((SBool, TPProofRaw (SBV t)) -> Symbolic SBool)
-> Symbolic SBool
forall a b.
SymbolicT IO a -> (a -> SymbolicT IO b) -> SymbolicT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> (SBool, TPProofRaw (SBV t)) -> Symbolic SBool
forall a.
SymVal a =>
[Int] -> (SBool, TPProofRaw (SBV a)) -> Symbolic SBool
qcRun [Int]
checkedLabel)

-- | Instantiation for a universally quantified variable
newtype Inst (nm :: Symbol) a = Inst (SBV a)

instance KnownSymbol nm => Show (Inst nm a) where
   show :: Inst nm a -> String
show (Inst SBV a
a) = Proxy nm -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @nm) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" |-> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SBV a -> String
forall a. Show a => a -> String
show SBV a
a

-- | Instantiating a proof at a particular choice of arguments
class Instantiatable a where
  type IArgs a :: Type

  -- | Apply a universal proof to some arguments, creating a boolean expression guaranteed to be true
  at :: Proof a -> IArgs a -> Proof Bool

-- | Instantiation a single parameter proof
instance (KnownSymbol na, Typeable a) => Instantiatable (Forall na a -> SBool) where
  type IArgs (Forall na a -> SBool) = Inst na a

  at :: Proof (Forall na a -> SBool)
-> IArgs (Forall na a -> SBool) -> Proof Bool
at = ((Forall na a -> SBool) -> IArgs (Forall na a -> SBool) -> SBool)
-> Proof (Forall na a -> SBool)
-> IArgs (Forall na a -> SBool)
-> Proof Bool
forall f arg a.
(Typeable f, Show arg) =>
(f -> arg -> SBool) -> Proof a -> arg -> Proof Bool
instantiate (((Forall na a -> SBool) -> IArgs (Forall na a -> SBool) -> SBool)
 -> Proof (Forall na a -> SBool)
 -> IArgs (Forall na a -> SBool)
 -> Proof Bool)
-> ((Forall na a -> SBool)
    -> IArgs (Forall na a -> SBool) -> SBool)
-> Proof (Forall na a -> SBool)
-> IArgs (Forall na a -> SBool)
-> Proof Bool
forall a b. (a -> b) -> a -> b
$ \Forall na a -> SBool
f (Inst SBV a
a) -> Forall na a -> SBool
f (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a :: Forall na a)

-- | Two parameters
instance ( KnownSymbol na, HasKind a, Typeable a
         , KnownSymbol nb, HasKind b, Typeable b
         ) => Instantiatable (Forall na a -> Forall nb b -> SBool) where
  type IArgs (Forall na a -> Forall nb b -> SBool) = (Inst na a, Inst nb b)

  at :: Proof (Forall na a -> Forall nb b -> SBool)
-> IArgs (Forall na a -> Forall nb b -> SBool) -> Proof Bool
at  = ((Forall na a -> Forall nb b -> SBool)
 -> IArgs (Forall na a -> Forall nb b -> SBool) -> SBool)
-> Proof (Forall na a -> Forall nb b -> SBool)
-> IArgs (Forall na a -> Forall nb b -> SBool)
-> Proof Bool
forall f arg a.
(Typeable f, Show arg) =>
(f -> arg -> SBool) -> Proof a -> arg -> Proof Bool
instantiate (((Forall na a -> Forall nb b -> SBool)
  -> IArgs (Forall na a -> Forall nb b -> SBool) -> SBool)
 -> Proof (Forall na a -> Forall nb b -> SBool)
 -> IArgs (Forall na a -> Forall nb b -> SBool)
 -> Proof Bool)
-> ((Forall na a -> Forall nb b -> SBool)
    -> IArgs (Forall na a -> Forall nb b -> SBool) -> SBool)
-> Proof (Forall na a -> Forall nb b -> SBool)
-> IArgs (Forall na a -> Forall nb b -> SBool)
-> Proof Bool
forall a b. (a -> b) -> a -> b
$ \Forall na a -> Forall nb b -> SBool
f (Inst SBV a
a, Inst SBV b
b) -> Forall na a -> Forall nb b -> SBool
f (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a :: Forall na a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b :: Forall nb b)

-- | Three parameters
instance ( KnownSymbol na, HasKind a, Typeable a
         , KnownSymbol nb, HasKind b, Typeable b
         , KnownSymbol nc, HasKind c, Typeable c
         ) => Instantiatable (Forall na a -> Forall nb b -> Forall nc c -> SBool) where
  type IArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool) = (Inst na a, Inst nb b, Inst nc c)

  at :: Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> IArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> Proof Bool
at  = ((Forall na a -> Forall nb b -> Forall nc c -> SBool)
 -> IArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool)
 -> SBool)
-> Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> IArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> Proof Bool
forall f arg a.
(Typeable f, Show arg) =>
(f -> arg -> SBool) -> Proof a -> arg -> Proof Bool
instantiate (((Forall na a -> Forall nb b -> Forall nc c -> SBool)
  -> IArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool)
  -> SBool)
 -> Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
 -> IArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool)
 -> Proof Bool)
-> ((Forall na a -> Forall nb b -> Forall nc c -> SBool)
    -> IArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool)
    -> SBool)
-> Proof (Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> IArgs (Forall na a -> Forall nb b -> Forall nc c -> SBool)
-> Proof Bool
forall a b. (a -> b) -> a -> b
$ \Forall na a -> Forall nb b -> Forall nc c -> SBool
f (Inst SBV a
a, Inst SBV b
b, Inst SBV c
c) -> Forall na a -> Forall nb b -> Forall nc c -> SBool
f (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a :: Forall na a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b :: Forall nb b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c :: Forall nc c)

-- | Four parameters
instance ( KnownSymbol na, HasKind a, Typeable a
         , KnownSymbol nb, HasKind b, Typeable b
         , KnownSymbol nc, HasKind c, Typeable c
         , KnownSymbol nd, HasKind d, Typeable d
         ) => Instantiatable (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool) where
  type IArgs (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool) = (Inst na a, Inst nb b, Inst nc c, Inst nd d)

  at :: Proof
  (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
-> IArgs
     (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
-> Proof Bool
at  = ((Forall na a
  -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
 -> IArgs
      (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
 -> SBool)
-> Proof
     (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
-> IArgs
     (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
-> Proof Bool
forall f arg a.
(Typeable f, Show arg) =>
(f -> arg -> SBool) -> Proof a -> arg -> Proof Bool
instantiate (((Forall na a
   -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
  -> IArgs
       (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
  -> SBool)
 -> Proof
      (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
 -> IArgs
      (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
 -> Proof Bool)
-> ((Forall na a
     -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
    -> IArgs
         (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
    -> SBool)
-> Proof
     (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
-> IArgs
     (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool)
-> Proof Bool
forall a b. (a -> b) -> a -> b
$ \Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool
f (Inst SBV a
a, Inst SBV b
b, Inst SBV c
c, Inst SBV d
d) -> Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> SBool
f (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a :: Forall na a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b :: Forall nb b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c :: Forall nc c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d :: Forall nd d)

-- | Five parameters
instance ( KnownSymbol na, HasKind a, Typeable a
         , KnownSymbol nb, HasKind b, Typeable b
         , KnownSymbol nc, HasKind c, Typeable c
         , KnownSymbol nd, HasKind d, Typeable d
         , KnownSymbol ne, HasKind e, Typeable e
         ) => Instantiatable (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) where
  type IArgs (Forall na a -> Forall nb b -> Forall nc c -> Forall nd d -> Forall ne e -> SBool) = (Inst na a, Inst nb b, Inst nc c, Inst nd d, Inst ne e)

  at :: Proof
  (Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
-> IArgs
     (Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
-> Proof Bool
at  = ((Forall na a
  -> Forall nb b
  -> Forall nc c
  -> Forall nd d
  -> Forall ne e
  -> SBool)
 -> IArgs
      (Forall na a
       -> Forall nb b
       -> Forall nc c
       -> Forall nd d
       -> Forall ne e
       -> SBool)
 -> SBool)
-> Proof
     (Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
-> IArgs
     (Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
-> Proof Bool
forall f arg a.
(Typeable f, Show arg) =>
(f -> arg -> SBool) -> Proof a -> arg -> Proof Bool
instantiate (((Forall na a
   -> Forall nb b
   -> Forall nc c
   -> Forall nd d
   -> Forall ne e
   -> SBool)
  -> IArgs
       (Forall na a
        -> Forall nb b
        -> Forall nc c
        -> Forall nd d
        -> Forall ne e
        -> SBool)
  -> SBool)
 -> Proof
      (Forall na a
       -> Forall nb b
       -> Forall nc c
       -> Forall nd d
       -> Forall ne e
       -> SBool)
 -> IArgs
      (Forall na a
       -> Forall nb b
       -> Forall nc c
       -> Forall nd d
       -> Forall ne e
       -> SBool)
 -> Proof Bool)
-> ((Forall na a
     -> Forall nb b
     -> Forall nc c
     -> Forall nd d
     -> Forall ne e
     -> SBool)
    -> IArgs
         (Forall na a
          -> Forall nb b
          -> Forall nc c
          -> Forall nd d
          -> Forall ne e
          -> SBool)
    -> SBool)
-> Proof
     (Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
-> IArgs
     (Forall na a
      -> Forall nb b
      -> Forall nc c
      -> Forall nd d
      -> Forall ne e
      -> SBool)
-> Proof Bool
forall a b. (a -> b) -> a -> b
$ \Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
f (Inst SBV a
a, Inst SBV b
b, Inst SBV c
c, Inst SBV d
d, Inst SBV e
e) -> Forall na a
-> Forall nb b
-> Forall nc c
-> Forall nd d
-> Forall ne e
-> SBool
f (SBV a -> Forall na a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV a
a :: Forall na a) (SBV b -> Forall nb b
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV b
b :: Forall nb b) (SBV c -> Forall nc c
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV c
c :: Forall nc c) (SBV d -> Forall nd d
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV d
d :: Forall nd d) (SBV e -> Forall ne e
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall SBV e
e :: Forall ne e)

-- | Instantiate a proof over an arg. This uses dynamic typing, kind of hacky, but works sufficiently well.
instantiate :: (Typeable f, Show arg) => (f -> arg -> SBool) -> Proof a -> arg -> Proof Bool
instantiate :: forall f arg a.
(Typeable f, Show arg) =>
(f -> arg -> SBool) -> Proof a -> arg -> Proof Bool
instantiate f -> arg -> SBool
ap (Proof p :: ProofObj
p@ProofObj{Dynamic
getProp :: ProofObj -> Dynamic
getProp :: Dynamic
getProp, String
proofName :: ProofObj -> String
proofName :: String
proofName}) arg
a = case Dynamic -> Maybe f
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
getProp of
                                                            Maybe f
Nothing -> Proof Bool
cantInstantiate
                                                            Just f
f  -> let result :: SBool
result = f
f f -> arg -> SBool
`ap` arg
a
                                                                           nm :: String
nm     = String
proofName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" @ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
paren String
sha
                                                                       in ProofObj -> Proof Bool
forall a. ProofObj -> Proof a
Proof (ProofObj -> Proof Bool) -> ProofObj -> Proof Bool
forall a b. (a -> b) -> a -> b
$ ProofObj
p { getObjProof = label nm result
                                                                                    , getProp     = toDyn result
                                                                                    , proofName   = nm
                                                                                    }
 where sha :: String
sha = arg -> String
forall a. Show a => a -> String
show arg
a
       cantInstantiate :: Proof Bool
cantInstantiate = String -> Proof Bool
forall a. HasCallStack => String -> a
error (String -> Proof Bool) -> String -> Proof Bool
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
"***"
                                         , String
"Data.SBV.TP: Impossible happened: Cannot instantiate proof:"
                                         , String
""
                                         , String
"   Name: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
proofName
                                         , String
"   Type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
trim (Dynamic -> String
forall a. Show a => a -> String
show Dynamic
getProp)
                                         , String
"   At  : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sha
                                         , String
""
                                         , String
"Please report this as a bug!"
                                         ]

       -- dynamic puts funky <</>> at the beginning and end; trim it:
       trim :: String -> String
trim  (Char
'<':Char
'<':String
s) = String -> String
forall a. [a] -> [a]
reverse (String -> String
trimE (String -> String
forall a. [a] -> [a]
reverse String
s))
       trim  String
s           = String
s
       trimE :: String -> String
trimE (Char
'>':Char
'>':String
s) = String
s
       trimE String
s           = String
s

       -- Add parens if necessary
       paren :: String -> String
paren String
s | String
"(" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s Bool -> Bool -> Bool
&& String
")" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
s = String
s
               | Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace String
s)                      = String
s
               | Bool
True                                     = Char
'(' Char -> String -> String
forall a. a -> [a] -> [a]
: String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

-- | Helpers for a step
data Helper = HelperProof  ProofObj     -- A previously proven theorem
            | HelperAssum  SBool        -- A hypothesis
            | HelperQC     QC.Args      -- Quickcheck with these args
            | HelperString String       -- Just a text, only used for diagnostics
            | HelperDisp   String SVal  -- Show the value of this expression in case of failure

-- | Get all helpers used in a proof
getAllHelpers :: TPProof -> [Helper]
getAllHelpers :: TPProof -> [Helper]
getAllHelpers (ProofStep   SBool
_           [Helper]
hs               TPProof
p)  = [Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ TPProof -> [Helper]
getAllHelpers TPProof
p
getAllHelpers (ProofBranch (Bool
_ :: Bool) ([String]
_ :: [String]) [(SBool, TPProof)]
ps) = ((SBool, TPProof) -> [Helper]) -> [(SBool, TPProof)] -> [Helper]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (TPProof -> [Helper]
getAllHelpers (TPProof -> [Helper])
-> ((SBool, TPProof) -> TPProof) -> (SBool, TPProof) -> [Helper]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SBool, TPProof) -> TPProof
forall a b. (a, b) -> b
snd) [(SBool, TPProof)]
ps
getAllHelpers (ProofEnd    SBool
_           [Helper]
hs                ) = [Helper]
hs

-- | Get proofs from helpers
getHelperProofs :: Helper -> [ProofObj]
getHelperProofs :: Helper -> [ProofObj]
getHelperProofs (HelperProof ProofObj
p) = [ProofObj
p]
getHelperProofs HelperAssum {}  = []
getHelperProofs HelperQC    {}  = [ProofObj
quickCheckProof]
getHelperProofs HelperString{}  = []
getHelperProofs HelperDisp{}    = []

-- | Get proofs from helpers
getHelperAssumes :: Helper -> [SBool]
getHelperAssumes :: Helper -> [SBool]
getHelperAssumes HelperProof  {} = []
getHelperAssumes (HelperAssum SBool
b) = [SBool
b]
getHelperAssumes HelperQC     {} = []
getHelperAssumes HelperString {} = []
getHelperAssumes HelperDisp{}    = []

-- | Get hint strings from helpers. If there's an explicit comment given, just pass that. If not, collect all the names
getHelperText :: [Helper] -> [String]
getHelperText :: [Helper] -> [String]
getHelperText [Helper]
hs = case [String
s | HelperString String
s <- [Helper]
hs] of
                     [] -> (Helper -> [String]) -> [Helper] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Helper -> [String]
collect [Helper]
hs
                     [String]
ss -> [String]
ss
  where collect :: Helper -> [String]
        collect :: Helper -> [String]
collect (HelperProof  ProofObj
p) = [ProofObj -> String
proofName ProofObj
p | ProofObj -> Bool
isUserAxiom ProofObj
p]  -- Don't put out internals (inductive hypotheses)
        collect HelperAssum  {}  = []
        collect (HelperQC     Args
i) = [String
"qc: Running " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Args -> Int
QC.maxSuccess Args
i) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" tests"]
        collect (HelperString String
s) = [String
s]
        collect HelperDisp{}     = []

-- | A proof is a sequence of steps, supporting branching
data TPProofGen a bh b = ProofStep   a    [Helper] (TPProofGen a bh b)          -- ^ A single step
                       | ProofBranch Bool bh       [(SBool, TPProofGen a bh b)] -- ^ A branching step. Bool indicates if completeness check is needed
                       | ProofEnd    b    [Helper]                              -- ^ End of proof

-- | A proof, as written by the user. No produced result, but helpers on branches
type TPProofRaw a = TPProofGen a [Helper] ()

-- | A proof, as processed by TP. Producing a boolean result and each step is a boolean. Helpers on branches dispersed down, only strings are left for printing
type TPProof = TPProofGen SBool [String] SBool

-- | Collect dependencies for a TPProof
getDependencies :: TPProof -> [ProofObj]
getDependencies :: TPProof -> [ProofObj]
getDependencies = TPProof -> [ProofObj]
forall {a} {bh} {b}. TPProofGen a bh b -> [ProofObj]
collect
  where collect :: TPProofGen a bh b -> [ProofObj]
collect (ProofStep   a
_ [Helper]
hs TPProofGen a bh b
next) = (Helper -> [ProofObj]) -> [Helper] -> [ProofObj]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Helper -> [ProofObj]
getHelperProofs [Helper]
hs [ProofObj] -> [ProofObj] -> [ProofObj]
forall a. [a] -> [a] -> [a]
++ TPProofGen a bh b -> [ProofObj]
collect TPProofGen a bh b
next
        collect (ProofBranch Bool
_ bh
_  [(SBool, TPProofGen a bh b)]
bs)   = ((SBool, TPProofGen a bh b) -> [ProofObj])
-> [(SBool, TPProofGen a bh b)] -> [ProofObj]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (TPProofGen a bh b -> [ProofObj]
collect (TPProofGen a bh b -> [ProofObj])
-> ((SBool, TPProofGen a bh b) -> TPProofGen a bh b)
-> (SBool, TPProofGen a bh b)
-> [ProofObj]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SBool, TPProofGen a bh b) -> TPProofGen a bh b
forall a b. (a, b) -> b
snd) [(SBool, TPProofGen a bh b)]
bs
        collect (ProofEnd    b
_    [Helper]
hs)   = (Helper -> [ProofObj]) -> [Helper] -> [ProofObj]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Helper -> [ProofObj]
getHelperProofs [Helper]
hs

-- | Class capturing giving a proof-step helper
type family Hinted a where
  Hinted (TPProofRaw a) = TPProofRaw a
  Hinted a              = TPProofRaw a

-- | Attaching a hint
(??) :: HintsTo a b => a -> b -> Hinted a
?? :: forall a b. HintsTo a b => a -> b -> Hinted a
(??) = a -> b -> Hinted a
forall a b. HintsTo a b => a -> b -> Hinted a
addHint
infixl 2 ??

-- | Alternative unicode for `??`.
(∵) :: HintsTo a b => a -> b -> Hinted a
∵ :: forall a b. HintsTo a b => a -> b -> Hinted a
(∵) = a -> b -> Hinted a
forall a b. HintsTo a b => a -> b -> Hinted a
(??)
infixl 2 ∵

-- | Class capturing hints
class HintsTo a b where
  addHint :: a -> b -> Hinted a

-- | Giving just one proof as a helper.
instance Hinted a ~ TPProofRaw a => HintsTo a (Proof b) where
  a
a addHint :: a -> Proof b -> Hinted a
`addHint` Proof b
p = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep a
a [ProofObj -> Helper
HelperProof (Proof b -> ProofObj
forall a. Proof a -> ProofObj
proofOf Proof b
p)] TPProofRaw a
forall a. TPProofRaw a
qed

-- | Giving a bunch of proofs at the same type as a helper.
instance Hinted a ~ TPProofRaw a => HintsTo a [Proof b] where
  a
a addHint :: a -> [Proof b] -> Hinted a
`addHint` [Proof b]
ps = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep a
a ((Proof b -> Helper) -> [Proof b] -> [Helper]
forall a b. (a -> b) -> [a] -> [b]
map (ProofObj -> Helper
HelperProof (ProofObj -> Helper) -> (Proof b -> ProofObj) -> Proof b -> Helper
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof b -> ProofObj
forall a. Proof a -> ProofObj
proofOf) [Proof b]
ps) TPProofRaw a
forall a. TPProofRaw a
qed

-- | Giving just one proof-obj as a helper.
instance Hinted a ~ TPProofRaw a => HintsTo a ProofObj where
  a
a addHint :: a -> ProofObj -> Hinted a
`addHint` ProofObj
p = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep a
a [ProofObj -> Helper
HelperProof ProofObj
p] TPProofRaw a
forall a. TPProofRaw a
qed

-- | Giving a bunch of proof-objs at the same type as a helper.
instance Hinted a ~ TPProofRaw a => HintsTo a [ProofObj] where
  a
a addHint :: a -> [ProofObj] -> Hinted a
`addHint` [ProofObj]
ps = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep a
a ((ProofObj -> Helper) -> [ProofObj] -> [Helper]
forall a b. (a -> b) -> [a] -> [b]
map ProofObj -> Helper
HelperProof [ProofObj]
ps) TPProofRaw a
forall a. TPProofRaw a
qed

-- | Giving just one boolean as a helper.
instance Hinted a ~ TPProofRaw a => HintsTo a SBool where
  a
a addHint :: a -> SBool -> Hinted a
`addHint` SBool
p = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep a
a [SBool -> Helper
HelperAssum SBool
p] TPProofRaw a
forall a. TPProofRaw a
qed

-- | Giving a list of booleans as a helper.
instance Hinted a ~ TPProofRaw a => HintsTo a [SBool] where
  a
a addHint :: a -> [SBool] -> Hinted a
`addHint` [SBool]
ps = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep a
a ((SBool -> Helper) -> [SBool] -> [Helper]
forall a b. (a -> b) -> [a] -> [b]
map SBool -> Helper
HelperAssum [SBool]
ps) TPProofRaw a
forall a. TPProofRaw a
qed

-- | Giving just one helper
instance Hinted a ~ TPProofRaw a => HintsTo a Helper where
  a
a addHint :: a -> Helper -> Hinted a
`addHint` Helper
h = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep a
a [Helper
h] TPProofRaw a
forall a. TPProofRaw a
qed

-- | Giving a list of helper
instance Hinted a ~ TPProofRaw a => HintsTo a [Helper] where
  a
a addHint :: a -> [Helper] -> Hinted a
`addHint` [Helper]
hs = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep a
a [Helper]
hs TPProofRaw a
forall a. TPProofRaw a
qed

-- | Giving user a hint as a string. This doesn't actually do anything for the solver, it just helps with readability
instance Hinted a ~ TPProofRaw a => HintsTo a String where
  a
a addHint :: a -> String -> Hinted a
`addHint` String
s = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep a
a [String -> Helper
HelperString String
s] TPProofRaw a
forall a. TPProofRaw a
qed

-- | Giving a bunch of strings
instance Hinted a ~ TPProofRaw a => HintsTo a [String] where
  a
a addHint :: a -> [String] -> Hinted a
`addHint` [String]
ss = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep a
a ((String -> Helper) -> [String] -> [Helper]
forall a b. (a -> b) -> [a] -> [b]
map String -> Helper
HelperString [String]
ss) TPProofRaw a
forall a. TPProofRaw a
qed

-- | Giving just one proof as a helper, starting from a proof
instance {-# OVERLAPPING #-} Hinted (TPProofRaw a) ~ TPProofRaw a => HintsTo (TPProofRaw a) (Proof b) where
  ProofStep   a
a [Helper]
hs TPProofRaw a
ps addHint :: TPProofRaw a -> Proof b -> Hinted (TPProofRaw a)
`addHint` Proof b
h = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep   a
a ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [ProofObj -> Helper
HelperProof (Proof b -> ProofObj
forall a. Proof a -> ProofObj
proofOf Proof b
h)]) TPProofRaw a
ps
  ProofBranch Bool
b [Helper]
hs [(SBool, TPProofRaw a)]
bs `addHint` Proof b
h = Bool -> [Helper] -> [(SBool, TPProofRaw a)] -> TPProofRaw a
forall a bh b.
Bool -> bh -> [(SBool, TPProofGen a bh b)] -> TPProofGen a bh b
ProofBranch Bool
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [ProofObj -> Helper
HelperProof (Proof b -> ProofObj
forall a. Proof a -> ProofObj
proofOf Proof b
h)]) [(SBool, TPProofRaw a)]
bs
  ProofEnd    ()
b [Helper]
hs    `addHint` Proof b
h = () -> [Helper] -> TPProofRaw a
forall a bh b. b -> [Helper] -> TPProofGen a bh b
ProofEnd    ()
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [ProofObj -> Helper
HelperProof (Proof b -> ProofObj
forall a. Proof a -> ProofObj
proofOf Proof b
h)])

-- | Giving just one proofobj as a helper, starting from a proof
instance {-# OVERLAPPING #-} Hinted (TPProofRaw a) ~ TPProofRaw a => HintsTo (TPProofRaw a) ProofObj where
  ProofStep   a
a [Helper]
hs TPProofRaw a
ps addHint :: TPProofRaw a -> ProofObj -> Hinted (TPProofRaw a)
`addHint` ProofObj
h = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep   a
a ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [ProofObj -> Helper
HelperProof ProofObj
h]) TPProofRaw a
ps
  ProofBranch Bool
b [Helper]
hs [(SBool, TPProofRaw a)]
bs `addHint` ProofObj
h = Bool -> [Helper] -> [(SBool, TPProofRaw a)] -> TPProofRaw a
forall a bh b.
Bool -> bh -> [(SBool, TPProofGen a bh b)] -> TPProofGen a bh b
ProofBranch Bool
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [ProofObj -> Helper
HelperProof ProofObj
h]) [(SBool, TPProofRaw a)]
bs
  ProofEnd    ()
b [Helper]
hs    `addHint` ProofObj
h = () -> [Helper] -> TPProofRaw a
forall a bh b. b -> [Helper] -> TPProofGen a bh b
ProofEnd    ()
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [ProofObj -> Helper
HelperProof ProofObj
h])

-- | Giving a bunch of proofs at the same type as a helper, starting from a proof
instance {-# OVERLAPPING #-} Hinted (TPProofRaw a) ~ TPProofRaw a => HintsTo (TPProofRaw a) [Proof b] where
  ProofStep   a
a [Helper]
hs TPProofRaw a
ps addHint :: TPProofRaw a -> [Proof b] -> Hinted (TPProofRaw a)
`addHint` [Proof b]
hs' = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep   a
a ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ (Proof b -> Helper) -> [Proof b] -> [Helper]
forall a b. (a -> b) -> [a] -> [b]
map (ProofObj -> Helper
HelperProof (ProofObj -> Helper) -> (Proof b -> ProofObj) -> Proof b -> Helper
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof b -> ProofObj
forall a. Proof a -> ProofObj
proofOf) [Proof b]
hs') TPProofRaw a
ps
  ProofBranch Bool
b [Helper]
hs [(SBool, TPProofRaw a)]
bs `addHint` [Proof b]
hs' = Bool -> [Helper] -> [(SBool, TPProofRaw a)] -> TPProofRaw a
forall a bh b.
Bool -> bh -> [(SBool, TPProofGen a bh b)] -> TPProofGen a bh b
ProofBranch Bool
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ (Proof b -> Helper) -> [Proof b] -> [Helper]
forall a b. (a -> b) -> [a] -> [b]
map (ProofObj -> Helper
HelperProof (ProofObj -> Helper) -> (Proof b -> ProofObj) -> Proof b -> Helper
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof b -> ProofObj
forall a. Proof a -> ProofObj
proofOf) [Proof b]
hs') [(SBool, TPProofRaw a)]
bs
  ProofEnd    ()
b [Helper]
hs    `addHint` [Proof b]
hs' = () -> [Helper] -> TPProofRaw a
forall a bh b. b -> [Helper] -> TPProofGen a bh b
ProofEnd    ()
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ (Proof b -> Helper) -> [Proof b] -> [Helper]
forall a b. (a -> b) -> [a] -> [b]
map (ProofObj -> Helper
HelperProof (ProofObj -> Helper) -> (Proof b -> ProofObj) -> Proof b -> Helper
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof b -> ProofObj
forall a. Proof a -> ProofObj
proofOf) [Proof b]
hs')

-- | Giving just one boolean as a helper.
instance {-# OVERLAPPING #-} Hinted (TPProofRaw a) ~ TPProofRaw a => HintsTo (TPProofRaw a) SBool where
  ProofStep   a
a [Helper]
hs TPProofRaw a
ps addHint :: TPProofRaw a -> SBool -> Hinted (TPProofRaw a)
`addHint` SBool
h = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep   a
a ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [SBool -> Helper
HelperAssum SBool
h]) TPProofRaw a
ps
  ProofBranch Bool
b [Helper]
hs [(SBool, TPProofRaw a)]
bs `addHint` SBool
h = Bool -> [Helper] -> [(SBool, TPProofRaw a)] -> TPProofRaw a
forall a bh b.
Bool -> bh -> [(SBool, TPProofGen a bh b)] -> TPProofGen a bh b
ProofBranch Bool
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [SBool -> Helper
HelperAssum SBool
h]) [(SBool, TPProofRaw a)]
bs
  ProofEnd    ()
b [Helper]
hs    `addHint` SBool
h = () -> [Helper] -> TPProofRaw a
forall a bh b. b -> [Helper] -> TPProofGen a bh b
ProofEnd    ()
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [SBool -> Helper
HelperAssum SBool
h])

-- | Giving a bunch of booleans as a helper.
instance {-# OVERLAPPING #-} Hinted (TPProofRaw a) ~ TPProofRaw a => HintsTo (TPProofRaw a) [SBool] where
  ProofStep   a
a [Helper]
hs TPProofRaw a
ps addHint :: TPProofRaw a -> [SBool] -> Hinted (TPProofRaw a)
`addHint` [SBool]
hs' = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep   a
a ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ (SBool -> Helper) -> [SBool] -> [Helper]
forall a b. (a -> b) -> [a] -> [b]
map SBool -> Helper
HelperAssum [SBool]
hs') TPProofRaw a
ps
  ProofBranch Bool
b [Helper]
hs [(SBool, TPProofRaw a)]
bs `addHint` [SBool]
hs' = Bool -> [Helper] -> [(SBool, TPProofRaw a)] -> TPProofRaw a
forall a bh b.
Bool -> bh -> [(SBool, TPProofGen a bh b)] -> TPProofGen a bh b
ProofBranch Bool
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ (SBool -> Helper) -> [SBool] -> [Helper]
forall a b. (a -> b) -> [a] -> [b]
map SBool -> Helper
HelperAssum [SBool]
hs') [(SBool, TPProofRaw a)]
bs
  ProofEnd    ()
b [Helper]
hs    `addHint` [SBool]
hs' = () -> [Helper] -> TPProofRaw a
forall a bh b. b -> [Helper] -> TPProofGen a bh b
ProofEnd    ()
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ (SBool -> Helper) -> [SBool] -> [Helper]
forall a b. (a -> b) -> [a] -> [b]
map SBool -> Helper
HelperAssum [SBool]
hs')

-- | Giving just one helper
instance {-# OVERLAPPING #-} Hinted (TPProofRaw a) ~ TPProofRaw a => HintsTo (TPProofRaw a) Helper where
  ProofStep   a
a [Helper]
hs TPProofRaw a
ps addHint :: TPProofRaw a -> Helper -> Hinted (TPProofRaw a)
`addHint` Helper
h = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep   a
a ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [Helper
h]) TPProofRaw a
ps
  ProofBranch Bool
b [Helper]
hs [(SBool, TPProofRaw a)]
bs `addHint` Helper
h = Bool -> [Helper] -> [(SBool, TPProofRaw a)] -> TPProofRaw a
forall a bh b.
Bool -> bh -> [(SBool, TPProofGen a bh b)] -> TPProofGen a bh b
ProofBranch Bool
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [Helper
h]) [(SBool, TPProofRaw a)]
bs
  ProofEnd    ()
b [Helper]
hs    `addHint` Helper
h = () -> [Helper] -> TPProofRaw a
forall a bh b. b -> [Helper] -> TPProofGen a bh b
ProofEnd    ()
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [Helper
h])

-- | Giving a set of helpers
instance {-# OVERLAPPING #-} Hinted (TPProofRaw a) ~ TPProofRaw a => HintsTo (TPProofRaw a) [Helper] where
  ProofStep   a
a [Helper]
hs TPProofRaw a
ps addHint :: TPProofRaw a -> [Helper] -> Hinted (TPProofRaw a)
`addHint` [Helper]
hs' = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep   a
a ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [Helper]
hs') TPProofRaw a
ps
  ProofBranch Bool
b [Helper]
hs [(SBool, TPProofRaw a)]
bs `addHint` [Helper]
hs' = Bool -> [Helper] -> [(SBool, TPProofRaw a)] -> TPProofRaw a
forall a bh b.
Bool -> bh -> [(SBool, TPProofGen a bh b)] -> TPProofGen a bh b
ProofBranch Bool
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [Helper]
hs') [(SBool, TPProofRaw a)]
bs
  ProofEnd    ()
b [Helper]
hs    `addHint` [Helper]
hs' = () -> [Helper] -> TPProofRaw a
forall a bh b. b -> [Helper] -> TPProofGen a bh b
ProofEnd    ()
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [Helper]
hs')

-- | Giving user a hint as a string. This doesn't actually do anything for the solver, it just helps with readability
instance {-# OVERLAPPING #-} Hinted (TPProofRaw a) ~ TPProofRaw a => HintsTo (TPProofRaw a) String where
  TPProofRaw a
a addHint :: TPProofRaw a -> String -> Hinted (TPProofRaw a)
`addHint` String
s = TPProofRaw a
a TPProofRaw a -> Helper -> Hinted (TPProofRaw a)
forall a b. HintsTo a b => a -> b -> Hinted a
`addHint` String -> Helper
HelperString String
s

-- | Giving a bunch of strings as hints. This doesn't actually do anything for the solver, it just helps with readability
instance {-# OVERLAPPING #-} Hinted (TPProofRaw a) ~ TPProofRaw a => HintsTo (TPProofRaw a) [String] where
  TPProofRaw a
a addHint :: TPProofRaw a -> [String] -> Hinted (TPProofRaw a)
`addHint` [String]
ss = TPProofRaw a
a TPProofRaw a -> [Helper] -> Hinted (TPProofRaw a)
forall a b. HintsTo a b => a -> b -> Hinted a
`addHint` (String -> Helper) -> [String] -> [Helper]
forall a b. (a -> b) -> [a] -> [b]
map String -> Helper
HelperString [String]
ss

-- | Giving a set of proof objects as helpers. This is helpful since we occasionally put a bunch of proofs together.
instance {-# OVERLAPPING #-} Hinted (TPProofRaw a) ~ TPProofRaw a => HintsTo (TPProofRaw a) [ProofObj] where
  ProofStep   a
a [Helper]
hs TPProofRaw a
ps addHint :: TPProofRaw a -> [ProofObj] -> Hinted (TPProofRaw a)
`addHint` [ProofObj]
hs' = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep   a
a ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ (ProofObj -> Helper) -> [ProofObj] -> [Helper]
forall a b. (a -> b) -> [a] -> [b]
map ProofObj -> Helper
HelperProof [ProofObj]
hs') TPProofRaw a
ps
  ProofBranch Bool
b [Helper]
hs [(SBool, TPProofRaw a)]
bs `addHint` [ProofObj]
hs' = Bool -> [Helper] -> [(SBool, TPProofRaw a)] -> TPProofRaw a
forall a bh b.
Bool -> bh -> [(SBool, TPProofGen a bh b)] -> TPProofGen a bh b
ProofBranch Bool
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ (ProofObj -> Helper) -> [ProofObj] -> [Helper]
forall a b. (a -> b) -> [a] -> [b]
map ProofObj -> Helper
HelperProof [ProofObj]
hs') [(SBool, TPProofRaw a)]
bs
  ProofEnd    ()
b [Helper]
hs    `addHint` [ProofObj]
hs' = () -> [Helper] -> TPProofRaw a
forall a bh b. b -> [Helper] -> TPProofGen a bh b
ProofEnd    ()
b ([Helper]
hs [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ (ProofObj -> Helper) -> [ProofObj] -> [Helper]
forall a b. (a -> b) -> [a] -> [b]
map ProofObj -> Helper
HelperProof [ProofObj]
hs')

-- | Capture what a given step can chain-to. This is a closed-type family, i.e.,
-- we don't allow users to change this and write other chainable things. Probably it is not really necessary,
-- but we'll cross that bridge if someone actually asks for it.
type family ChainsTo a where
  ChainsTo (TPProofRaw a) = TPProofRaw a
  ChainsTo a              = TPProofRaw a

-- | Chain steps in a calculational proof.
(=:) :: ChainStep a (ChainsTo a) =>  a -> ChainsTo a -> ChainsTo a
=: :: forall a. ChainStep a (ChainsTo a) => a -> ChainsTo a -> ChainsTo a
(=:) = a -> ChainsTo a -> ChainsTo a
forall a b. ChainStep a b => a -> b -> b
chain
infixr 1 =:

-- | Unicode alternative for `=:`.
(≡) :: ChainStep a (ChainsTo a) =>  a -> ChainsTo a -> ChainsTo a
≡ :: forall a. ChainStep a (ChainsTo a) => a -> ChainsTo a -> ChainsTo a
(≡) = a -> ChainsTo a -> ChainsTo a
forall a. ChainStep a (ChainsTo a) => a -> ChainsTo a -> ChainsTo a
(=:)
infixr 1 ≡

-- | Chaining two steps together
class ChainStep a b where
  chain :: a -> b -> b

-- | Chaining from a value without any annotation
instance ChainStep a (TPProofRaw a) where
  chain :: a -> TPProofRaw a -> TPProofRaw a
chain a
x TPProofRaw a
y = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep a
x [] TPProofRaw a
y

-- | Chaining from another proof step
instance ChainStep (TPProofRaw a) (TPProofRaw a) where
  chain :: TPProofRaw a -> TPProofRaw a -> TPProofRaw a
chain (ProofStep   a
a  [Helper]
hs  TPProofRaw a
p)  TPProofRaw a
y = a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep   a
a [Helper]
hs (TPProofRaw a -> TPProofRaw a -> TPProofRaw a
forall a b. ChainStep a b => a -> b -> b
chain TPProofRaw a
p TPProofRaw a
y)
  chain (ProofBranch Bool
c  [Helper]
hs  [(SBool, TPProofRaw a)]
ps) TPProofRaw a
y = Bool -> [Helper] -> [(SBool, TPProofRaw a)] -> TPProofRaw a
forall a bh b.
Bool -> bh -> [(SBool, TPProofGen a bh b)] -> TPProofGen a bh b
ProofBranch Bool
c [Helper]
hs [(SBool
branchCond, TPProofRaw a -> TPProofRaw a -> TPProofRaw a
forall a b. ChainStep a b => a -> b -> b
chain TPProofRaw a
p TPProofRaw a
y) | (SBool
branchCond, TPProofRaw a
p) <- [(SBool, TPProofRaw a)]
ps]
  chain (ProofEnd    () [Helper]
hs)     TPProofRaw a
y = case TPProofRaw a
y of
                                      ProofStep   a
a  [Helper]
hs' TPProofRaw a
p  -> a -> [Helper] -> TPProofRaw a -> TPProofRaw a
forall a bh b.
a -> [Helper] -> TPProofGen a bh b -> TPProofGen a bh b
ProofStep   a
a  ([Helper]
hs' [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [Helper]
hs) TPProofRaw a
p
                                      ProofBranch Bool
b  [Helper]
hs' [(SBool, TPProofRaw a)]
bs -> Bool -> [Helper] -> [(SBool, TPProofRaw a)] -> TPProofRaw a
forall a bh b.
Bool -> bh -> [(SBool, TPProofGen a bh b)] -> TPProofGen a bh b
ProofBranch Bool
b  ([Helper]
hs' [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [Helper]
hs) [(SBool, TPProofRaw a)]
bs
                                      ProofEnd    () [Helper]
hs'    -> () -> [Helper] -> TPProofRaw a
forall a bh b. b -> [Helper] -> TPProofGen a bh b
ProofEnd    () ([Helper]
hs' [Helper] -> [Helper] -> [Helper]
forall a. [a] -> [a] -> [a]
++ [Helper]
hs)

-- | Mark the end of a calculational proof.
qed :: TPProofRaw a
qed :: forall a. TPProofRaw a
qed = () -> [Helper] -> TPProofGen a [Helper] ()
forall a bh b. b -> [Helper] -> TPProofGen a bh b
ProofEnd () []

-- | Mark a trivial proof. This is essentially the same as 'qed', but reads better in proof scripts.
class Trivial a where
  -- | Mark a proof as trivial, i.e., the solver should be able to deduce it without any help.
  trivial :: a

-- | Trivial proofs with no arguments
instance Trivial (TPProofRaw a) where
  trivial :: TPProofRaw a
trivial = TPProofRaw a
forall a. TPProofRaw a
qed

-- | Trivial proofs with many arguments arguments
instance Trivial a => Trivial (b -> a) where
  trivial :: b -> a
trivial = a -> b -> a
forall a b. a -> b -> a
const a
forall a. Trivial a => a
trivial

-- | Mark a contradictory proof path. This is essentially the same as @sFalse := qed@, but reads better in proof scripts.
class Contradiction a where
  -- | Mark a proof as contradiction, i.e., the solver should be able to conclude it by reasoning that the current path is infeasible
  contradiction :: a

-- | Contradiction proofs with no arguments
instance Contradiction (TPProofRaw SBool) where
  contradiction :: TPProofRaw SBool
contradiction = SBool
sFalse SBool -> ChainsTo SBool -> ChainsTo SBool
forall a. ChainStep a (ChainsTo a) => a -> ChainsTo a -> ChainsTo a
=: ChainsTo SBool
TPProofRaw SBool
forall a. TPProofRaw a
qed

-- | Contradiction proofs with many arguments
instance Contradiction a => Contradiction (b -> a) where
  contradiction :: b -> a
contradiction = a -> b -> a
forall a b. a -> b -> a
const a
forall a. Contradiction a => a
contradiction

-- | Start a calculational proof, with the given hypothesis. Use @[]@ as the
-- first argument if the calculation holds unconditionally. The first argument is
-- typically used to introduce hypotheses in proofs of implications such as @A .=> B .=> C@, where
-- we would put @[A, B]@ as the starting assumption. You can name these and later use in the derivation steps.
(|-) :: [SBool] -> TPProofRaw a -> (SBool, TPProofRaw a)
[SBool]
bs |- :: forall a. [SBool] -> TPProofRaw a -> (SBool, TPProofRaw a)
|- TPProofRaw a
p = ([SBool] -> SBool
sAnd [SBool]
bs, TPProofRaw a
p)
infixl 0 |-

-- | Alternative unicode for `|-`.
(⊢) :: [SBool] -> TPProofRaw a -> (SBool, TPProofRaw a)
⊢ :: forall a. [SBool] -> TPProofRaw a -> (SBool, TPProofRaw a)
(⊢) = [SBool] -> TPProofRaw a -> (SBool, TPProofRaw a)
forall a. [SBool] -> TPProofRaw a -> (SBool, TPProofRaw a)
(|-)
infixl 0 ⊢

-- | The boolean case-split
cases :: [(SBool, TPProofRaw a)] -> TPProofRaw a
cases :: forall a. [(SBool, TPProofRaw a)] -> TPProofRaw a
cases = Bool
-> [Helper]
-> [(SBool, TPProofGen a [Helper] ())]
-> TPProofGen a [Helper] ()
forall a bh b.
Bool -> bh -> [(SBool, TPProofGen a bh b)] -> TPProofGen a bh b
ProofBranch Bool
True []

-- | Case splitting over a list; empty and full cases
split :: SymVal a => SList a -> TPProofRaw r -> (SBV a -> SList a -> TPProofRaw r) -> TPProofRaw r
split :: forall a r.
SymVal a =>
SList a
-> TPProofRaw r
-> (SBV a -> SList a -> TPProofRaw r)
-> TPProofRaw r
split SList a
xs TPProofRaw r
empty SBV a -> SList a -> TPProofRaw r
cons = Bool -> [Helper] -> [(SBool, TPProofRaw r)] -> TPProofRaw r
forall a bh b.
Bool -> bh -> [(SBool, TPProofGen a bh b)] -> TPProofGen a bh b
ProofBranch Bool
False [] [(SBool
cnil, TPProofRaw r
empty), (SBool
ccons, SBV a -> SList a -> TPProofRaw r
cons SBV a
h SList a
t)]
   where cnil :: SBool
cnil   = SList a -> SBool
forall a. SymVal a => SList a -> SBool
SL.null   SList a
xs
         (SBV a
h, SList a
t) = SList a -> (SBV a, SList a)
forall a. SymVal a => SList a -> (SBV a, SList a)
SL.uncons SList a
xs
         ccons :: SBool
ccons  = SBool -> SBool
sNot SBool
cnil SBool -> SBool -> SBool
.&& SList a
xs SList a -> SList a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.=== SBV a
h SBV a -> SList a -> SList a
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList a
t

-- | Case splitting over two lists; empty and full cases for each
split2 :: (SymVal a, SymVal b)
       => (SList a, SList b)
       -> TPProofRaw r
       -> ((SBV b, SList b)                     -> TPProofRaw r) -- empty first
       -> ((SBV a, SList a)                     -> TPProofRaw r) -- empty second
       -> ((SBV a, SList a) -> (SBV b, SList b) -> TPProofRaw r) -- neither empty
       -> TPProofRaw r
split2 :: forall a b r.
(SymVal a, SymVal b) =>
(SList a, SList b)
-> TPProofRaw r
-> ((SBV b, SList b) -> TPProofRaw r)
-> ((SBV a, SList a) -> TPProofRaw r)
-> ((SBV a, SList a) -> (SBV b, SList b) -> TPProofRaw r)
-> TPProofRaw r
split2 (SList a
xs, SList b
ys) TPProofRaw r
ee (SBV b, SList b) -> TPProofRaw r
ec (SBV a, SList a) -> TPProofRaw r
ce (SBV a, SList a) -> (SBV b, SList b) -> TPProofRaw r
cc = Bool -> [Helper] -> [(SBool, TPProofRaw r)] -> TPProofRaw r
forall a bh b.
Bool -> bh -> [(SBool, TPProofGen a bh b)] -> TPProofGen a bh b
ProofBranch Bool
False
                                          []
                                          [ (SBool
xnil  SBool -> SBool -> SBool
.&& SBool
ynil,  TPProofRaw r
ee)
                                          , (SBool
xnil  SBool -> SBool -> SBool
.&& SBool
ycons, (SBV b, SList b) -> TPProofRaw r
ec (SBV b
hy, SList b
ty))
                                          , (SBool
xcons SBool -> SBool -> SBool
.&& SBool
ynil,  (SBV a, SList a) -> TPProofRaw r
ce (SBV a
hx, SList a
tx))
                                          , (SBool
xcons SBool -> SBool -> SBool
.&& SBool
ycons, (SBV a, SList a) -> (SBV b, SList b) -> TPProofRaw r
cc (SBV a
hx, SList a
tx) (SBV b
hy, SList b
ty))
                                          ]
  where xnil :: SBool
xnil     = SList a -> SBool
forall a. SymVal a => SList a -> SBool
SL.null   SList a
xs
        (SBV a
hx, SList a
tx) = SList a -> (SBV a, SList a)
forall a. SymVal a => SList a -> (SBV a, SList a)
SL.uncons SList a
xs
        xcons :: SBool
xcons    = SBool -> SBool
sNot SBool
xnil SBool -> SBool -> SBool
.&& SList a
xs SList a -> SList a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.=== SBV a
hx SBV a -> SList a -> SList a
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList a
tx

        ynil :: SBool
ynil     = SList b -> SBool
forall a. SymVal a => SList a -> SBool
SL.null   SList b
ys
        (SBV b
hy, SList b
ty) = SList b -> (SBV b, SList b)
forall a. SymVal a => SList a -> (SBV a, SList a)
SL.uncons SList b
ys
        ycons :: SBool
ycons    = SBool -> SBool
sNot SBool
ynil SBool -> SBool -> SBool
.&& SList b
ys SList b -> SList b -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.=== SBV b
hy SBV b -> SList b -> SList b
forall a. SymVal a => SBV a -> SList a -> SList a
SL..: SList b
ty

-- | A quick-check step, taking number of tests.
qc :: Int -> Helper
qc :: Int -> Helper
qc Int
cnt = Args -> Helper
HelperQC Args
QC.stdArgs{QC.maxSuccess = cnt}

-- | A quick-check step, with specific quick-check args.
qcWith :: QC.Args -> Helper
qcWith :: Args -> Helper
qcWith = Args -> Helper
HelperQC

-- | Observing values in case of failure.
disp :: String -> SBV a -> Helper
disp :: forall a. String -> SBV a -> Helper
disp String
n SBV a
v = String -> SVal -> Helper
HelperDisp String
n (SBV a -> SVal
forall a. SBV a -> SVal
unSBV SBV a
v)

-- | Specifying a case-split, helps with the boolean case.
(==>) :: SBool -> TPProofRaw a -> (SBool, TPProofRaw a)
==> :: forall a. SBool -> TPProofRaw a -> (SBool, TPProofRaw a)
(==>) = (,)
infix 0 ==>

-- | Alternative unicode for `==>`
(⟹) :: SBool -> TPProofRaw a -> (SBool, TPProofRaw a)
⟹ :: forall a. SBool -> TPProofRaw a -> (SBool, TPProofRaw a)
(⟹) = SBool -> TPProofRaw a -> (SBool, TPProofRaw a)
forall a. SBool -> TPProofRaw a -> (SBool, TPProofRaw a)
(==>)
infix 0 ⟹

{- HLint ignore module "Eta reduce" -}