{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE ViewPatterns               #-}

module Telomare.Possible where

import Control.Applicative
import Control.Comonad.Cofree (Cofree ((:<)))
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader (Reader, ReaderT, ask, local, runReaderT)
import qualified Control.Monad.Reader as Reader
import Control.Monad.State.Strict (State, StateT)
import qualified Control.Monad.State.Strict as State
import Control.Monad.Trans.Class
import Data.Bifunctor
import Data.DList (DList)
import qualified Data.DList as DList
import Data.Fix (Fix (..), hoistFix')
import Data.Foldable
import Data.Functor.Classes
import Data.Functor.Foldable
import Data.Functor.Foldable.TH
import Data.Kind
import Data.List (partition, sortBy)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Monoid
-- import Data.SBV ((.<), (.>))
-- import qualified Data.SBV as SBV
-- import qualified Data.SBV.Control as SBVC
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Void
import Debug.Trace
import PrettyPrint
import Telomare (BreakState' (..), FragExpr (..), FragExprF (..),
                 FragExprUR (..), FragIndex, IExpr (..), IExprF (SetEnvF),
                 LocTag (DummyLoc), PartialType (..), RecursionPieceFrag,
                 RecursionSimulationPieces (..),
                 TelomareLike (fromTelomare, toTelomare), Term3 (..),
                 Term4 (..), UnsizedRecursionToken (UnsizedRecursionToken),
                 buildFragMap, deferF, forget, g2i, i2g, indentWithChildren',
                 indentWithOneChild, indentWithOneChild', indentWithTwoChildren,
                 indentWithTwoChildren', pattern AbortAny,
                 pattern AbortRecursion, pattern AbortUnsizeable, rootFrag,
                 sindent)
-- import           Telomare.TypeChecker
-- import Data.SBV.RegExp (everything)
import Telomare.RunTime (hvmEval)

debug :: Bool
debug :: Bool
debug = Bool
False

debugTrace :: String -> a -> a
debugTrace :: forall a. String -> a -> a
debugTrace String
s a
x = if Bool
debug then forall a. String -> a -> a
trace String
s a
x else a
x

anaM' :: (Monad m, Corecursive t, x ~ Base t, Traversable x) => (a -> m (Base t a)) -> a -> m t
anaM' :: forall (m :: * -> *) t (x :: * -> *) a.
(Monad m, Corecursive t, x ~ Base t, Traversable x) =>
(a -> m (Base t a)) -> a -> m t
anaM' a -> m (Base t a)
f = a -> m t
c where c :: a -> m t
c = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. Corecursive t => Base t t -> t
embed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m t
c) forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> m (Base t a)
f

-- testSBV :: SBV.Symbolic SBV.Word8
-- testSBV = do
--   b <- SBV.sBool "b"
--   a <- SBV.sWord8 "a"
--   SBV.constrain $ a + 5 .< 10
--   SBV.constrain $ a .> 2
--   SBV.constrain b
--   SBVC.query $ SBVC.checkSat >>= \case
--       SBVC.Unk   -> undefined -- error "Solver returned unknown!"
--       SBVC.Unsat -> undefined -- error "Solver couldn't solve constraints"
--       SBVC.Sat   -> SBVC.getValue a

-- testSBV' :: IO Int
-- testSBV' = fromIntegral <$> SBV.runSMT testSBV

data PartExprF f
  = ZeroSF
  | PairSF f f
  | EnvSF
  | SetEnvSF f
  | GateSF f f
  | LeftSF f
  | RightSF f
  deriving (PartExprF f -> PartExprF f -> Bool
forall f. Eq f => PartExprF f -> PartExprF f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartExprF f -> PartExprF f -> Bool
$c/= :: forall f. Eq f => PartExprF f -> PartExprF f -> Bool
== :: PartExprF f -> PartExprF f -> Bool
$c== :: forall f. Eq f => PartExprF f -> PartExprF f -> Bool
Eq, PartExprF f -> PartExprF f -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {f}. Ord f => Eq (PartExprF f)
forall f. Ord f => PartExprF f -> PartExprF f -> Bool
forall f. Ord f => PartExprF f -> PartExprF f -> Ordering
forall f. Ord f => PartExprF f -> PartExprF f -> PartExprF f
min :: PartExprF f -> PartExprF f -> PartExprF f
$cmin :: forall f. Ord f => PartExprF f -> PartExprF f -> PartExprF f
max :: PartExprF f -> PartExprF f -> PartExprF f
$cmax :: forall f. Ord f => PartExprF f -> PartExprF f -> PartExprF f
>= :: PartExprF f -> PartExprF f -> Bool
$c>= :: forall f. Ord f => PartExprF f -> PartExprF f -> Bool
> :: PartExprF f -> PartExprF f -> Bool
$c> :: forall f. Ord f => PartExprF f -> PartExprF f -> Bool
<= :: PartExprF f -> PartExprF f -> Bool
$c<= :: forall f. Ord f => PartExprF f -> PartExprF f -> Bool
< :: PartExprF f -> PartExprF f -> Bool
$c< :: forall f. Ord f => PartExprF f -> PartExprF f -> Bool
compare :: PartExprF f -> PartExprF f -> Ordering
$ccompare :: forall f. Ord f => PartExprF f -> PartExprF f -> Ordering
Ord, Int -> PartExprF f -> ShowS
forall f. Show f => Int -> PartExprF f -> ShowS
forall f. Show f => [PartExprF f] -> ShowS
forall f. Show f => PartExprF f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartExprF f] -> ShowS
$cshowList :: forall f. Show f => [PartExprF f] -> ShowS
show :: PartExprF f -> String
$cshow :: forall f. Show f => PartExprF f -> String
showsPrec :: Int -> PartExprF f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> PartExprF f -> ShowS
Show, forall a b. a -> PartExprF b -> PartExprF a
forall a b. (a -> b) -> PartExprF a -> PartExprF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PartExprF b -> PartExprF a
$c<$ :: forall a b. a -> PartExprF b -> PartExprF a
fmap :: forall a b. (a -> b) -> PartExprF a -> PartExprF b
$cfmap :: forall a b. (a -> b) -> PartExprF a -> PartExprF b
Functor, forall a. Eq a => a -> PartExprF a -> Bool
forall a. Num a => PartExprF a -> a
forall a. Ord a => PartExprF a -> a
forall m. Monoid m => PartExprF m -> m
forall a. PartExprF a -> Bool
forall a. PartExprF a -> Int
forall a. PartExprF a -> [a]
forall a. (a -> a -> a) -> PartExprF a -> a
forall m a. Monoid m => (a -> m) -> PartExprF a -> m
forall b a. (b -> a -> b) -> b -> PartExprF a -> b
forall a b. (a -> b -> b) -> b -> PartExprF a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => PartExprF a -> a
$cproduct :: forall a. Num a => PartExprF a -> a
sum :: forall a. Num a => PartExprF a -> a
$csum :: forall a. Num a => PartExprF a -> a
minimum :: forall a. Ord a => PartExprF a -> a
$cminimum :: forall a. Ord a => PartExprF a -> a
maximum :: forall a. Ord a => PartExprF a -> a
$cmaximum :: forall a. Ord a => PartExprF a -> a
elem :: forall a. Eq a => a -> PartExprF a -> Bool
$celem :: forall a. Eq a => a -> PartExprF a -> Bool
length :: forall a. PartExprF a -> Int
$clength :: forall a. PartExprF a -> Int
null :: forall a. PartExprF a -> Bool
$cnull :: forall a. PartExprF a -> Bool
toList :: forall a. PartExprF a -> [a]
$ctoList :: forall a. PartExprF a -> [a]
foldl1 :: forall a. (a -> a -> a) -> PartExprF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> PartExprF a -> a
foldr1 :: forall a. (a -> a -> a) -> PartExprF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> PartExprF a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> PartExprF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> PartExprF a -> b
foldl :: forall b a. (b -> a -> b) -> b -> PartExprF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> PartExprF a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> PartExprF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> PartExprF a -> b
foldr :: forall a b. (a -> b -> b) -> b -> PartExprF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> PartExprF a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> PartExprF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> PartExprF a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> PartExprF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> PartExprF a -> m
fold :: forall m. Monoid m => PartExprF m -> m
$cfold :: forall m. Monoid m => PartExprF m -> m
Foldable, Functor PartExprF
Foldable PartExprF
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
PartExprF (m a) -> m (PartExprF a)
forall (f :: * -> *) a.
Applicative f =>
PartExprF (f a) -> f (PartExprF a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PartExprF a -> m (PartExprF b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PartExprF a -> f (PartExprF b)
sequence :: forall (m :: * -> *) a.
Monad m =>
PartExprF (m a) -> m (PartExprF a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
PartExprF (m a) -> m (PartExprF a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PartExprF a -> m (PartExprF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PartExprF a -> m (PartExprF b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
PartExprF (f a) -> f (PartExprF a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
PartExprF (f a) -> f (PartExprF a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PartExprF a -> f (PartExprF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PartExprF a -> f (PartExprF b)
Traversable)

instance Eq1 PartExprF where
  liftEq :: forall a b. (a -> b -> Bool) -> PartExprF a -> PartExprF b -> Bool
liftEq a -> b -> Bool
test PartExprF a
a PartExprF b
b = case (PartExprF a
a,PartExprF b
b) of
    (PartExprF a
ZeroSF, PartExprF b
ZeroSF)         -> Bool
True
    (PartExprF a
EnvSF, PartExprF b
EnvSF)           -> Bool
True
    (PairSF a
a a
b, PairSF b
c b
d) -> a -> b -> Bool
test a
a b
c Bool -> Bool -> Bool
&& a -> b -> Bool
test a
b b
d
    (SetEnvSF a
x, SetEnvSF b
y) -> a -> b -> Bool
test a
x b
y
    (GateSF a
a a
b, GateSF b
c b
d) -> a -> b -> Bool
test a
a b
c Bool -> Bool -> Bool
&& a -> b -> Bool
test a
b b
d
    (LeftSF a
x, LeftSF b
y)     -> a -> b -> Bool
test a
x b
y
    (RightSF a
x, RightSF b
y)   -> a -> b -> Bool
test a
x b
y
    (PartExprF a, PartExprF b)
_                        -> Bool
False

instance Show1 PartExprF where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> PartExprF a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrec [a] -> ShowS
showList Int
prec = \case
    PartExprF a
ZeroSF -> forall a. Show a => a -> ShowS
shows String
"ZeroSF"
    PairSF a
a a
b -> forall a. Show a => a -> ShowS
shows String
"PairSF (" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showsPrec Int
0 a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showsPrec Int
0 a
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
")"
    PartExprF a
EnvSF -> forall a. Show a => a -> ShowS
shows String
"EnvSF"
    SetEnvSF a
x -> forall a. Show a => a -> ShowS
shows String
"SetEnvSF (" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showsPrec Int
0 a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
")"
    GateSF a
l a
r -> forall a. Show a => a -> ShowS
shows String
"GateSF (" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showsPrec Int
0 a
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showsPrec Int
0 a
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
")"
    LeftSF a
x -> forall a. Show a => a -> ShowS
shows String
"LeftSF (" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showsPrec Int
0 a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
")"
    RightSF a
x -> forall a. Show a => a -> ShowS
shows String
"RightSF (" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showsPrec Int
0 a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
")"

newtype FunctionIndex = FunctionIndex { FunctionIndex -> Int
unFunctionIndex :: Int } deriving (FunctionIndex -> FunctionIndex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionIndex -> FunctionIndex -> Bool
$c/= :: FunctionIndex -> FunctionIndex -> Bool
== :: FunctionIndex -> FunctionIndex -> Bool
$c== :: FunctionIndex -> FunctionIndex -> Bool
Eq, Eq FunctionIndex
FunctionIndex -> FunctionIndex -> Bool
FunctionIndex -> FunctionIndex -> Ordering
FunctionIndex -> FunctionIndex -> FunctionIndex
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FunctionIndex -> FunctionIndex -> FunctionIndex
$cmin :: FunctionIndex -> FunctionIndex -> FunctionIndex
max :: FunctionIndex -> FunctionIndex -> FunctionIndex
$cmax :: FunctionIndex -> FunctionIndex -> FunctionIndex
>= :: FunctionIndex -> FunctionIndex -> Bool
$c>= :: FunctionIndex -> FunctionIndex -> Bool
> :: FunctionIndex -> FunctionIndex -> Bool
$c> :: FunctionIndex -> FunctionIndex -> Bool
<= :: FunctionIndex -> FunctionIndex -> Bool
$c<= :: FunctionIndex -> FunctionIndex -> Bool
< :: FunctionIndex -> FunctionIndex -> Bool
$c< :: FunctionIndex -> FunctionIndex -> Bool
compare :: FunctionIndex -> FunctionIndex -> Ordering
$ccompare :: FunctionIndex -> FunctionIndex -> Ordering
Ord, Int -> FunctionIndex
FunctionIndex -> Int
FunctionIndex -> [FunctionIndex]
FunctionIndex -> FunctionIndex
FunctionIndex -> FunctionIndex -> [FunctionIndex]
FunctionIndex -> FunctionIndex -> FunctionIndex -> [FunctionIndex]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FunctionIndex -> FunctionIndex -> FunctionIndex -> [FunctionIndex]
$cenumFromThenTo :: FunctionIndex -> FunctionIndex -> FunctionIndex -> [FunctionIndex]
enumFromTo :: FunctionIndex -> FunctionIndex -> [FunctionIndex]
$cenumFromTo :: FunctionIndex -> FunctionIndex -> [FunctionIndex]
enumFromThen :: FunctionIndex -> FunctionIndex -> [FunctionIndex]
$cenumFromThen :: FunctionIndex -> FunctionIndex -> [FunctionIndex]
enumFrom :: FunctionIndex -> [FunctionIndex]
$cenumFrom :: FunctionIndex -> [FunctionIndex]
fromEnum :: FunctionIndex -> Int
$cfromEnum :: FunctionIndex -> Int
toEnum :: Int -> FunctionIndex
$ctoEnum :: Int -> FunctionIndex
pred :: FunctionIndex -> FunctionIndex
$cpred :: FunctionIndex -> FunctionIndex
succ :: FunctionIndex -> FunctionIndex
$csucc :: FunctionIndex -> FunctionIndex
Enum, Int -> FunctionIndex -> ShowS
[FunctionIndex] -> ShowS
FunctionIndex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionIndex] -> ShowS
$cshowList :: [FunctionIndex] -> ShowS
show :: FunctionIndex -> String
$cshow :: FunctionIndex -> String
showsPrec :: Int -> FunctionIndex -> ShowS
$cshowsPrec :: Int -> FunctionIndex -> ShowS
Show)

instance PrettyPrintable FunctionIndex where
  showP :: FunctionIndex -> State Int String
showP = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"F" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

data StuckF f
  = DeferSF FunctionIndex f
  deriving (StuckF f -> StuckF f -> Bool
forall f. Eq f => StuckF f -> StuckF f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StuckF f -> StuckF f -> Bool
$c/= :: forall f. Eq f => StuckF f -> StuckF f -> Bool
== :: StuckF f -> StuckF f -> Bool
$c== :: forall f. Eq f => StuckF f -> StuckF f -> Bool
Eq, StuckF f -> StuckF f -> Bool
StuckF f -> StuckF f -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {f}. Ord f => Eq (StuckF f)
forall f. Ord f => StuckF f -> StuckF f -> Bool
forall f. Ord f => StuckF f -> StuckF f -> Ordering
forall f. Ord f => StuckF f -> StuckF f -> StuckF f
min :: StuckF f -> StuckF f -> StuckF f
$cmin :: forall f. Ord f => StuckF f -> StuckF f -> StuckF f
max :: StuckF f -> StuckF f -> StuckF f
$cmax :: forall f. Ord f => StuckF f -> StuckF f -> StuckF f
>= :: StuckF f -> StuckF f -> Bool
$c>= :: forall f. Ord f => StuckF f -> StuckF f -> Bool
> :: StuckF f -> StuckF f -> Bool
$c> :: forall f. Ord f => StuckF f -> StuckF f -> Bool
<= :: StuckF f -> StuckF f -> Bool
$c<= :: forall f. Ord f => StuckF f -> StuckF f -> Bool
< :: StuckF f -> StuckF f -> Bool
$c< :: forall f. Ord f => StuckF f -> StuckF f -> Bool
compare :: StuckF f -> StuckF f -> Ordering
$ccompare :: forall f. Ord f => StuckF f -> StuckF f -> Ordering
Ord, Int -> StuckF f -> ShowS
forall f. Show f => Int -> StuckF f -> ShowS
forall f. Show f => [StuckF f] -> ShowS
forall f. Show f => StuckF f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StuckF f] -> ShowS
$cshowList :: forall f. Show f => [StuckF f] -> ShowS
show :: StuckF f -> String
$cshow :: forall f. Show f => StuckF f -> String
showsPrec :: Int -> StuckF f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> StuckF f -> ShowS
Show, forall a b. a -> StuckF b -> StuckF a
forall a b. (a -> b) -> StuckF a -> StuckF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> StuckF b -> StuckF a
$c<$ :: forall a b. a -> StuckF b -> StuckF a
fmap :: forall a b. (a -> b) -> StuckF a -> StuckF b
$cfmap :: forall a b. (a -> b) -> StuckF a -> StuckF b
Functor, forall a. Eq a => a -> StuckF a -> Bool
forall a. Num a => StuckF a -> a
forall a. Ord a => StuckF a -> a
forall m. Monoid m => StuckF m -> m
forall a. StuckF a -> Bool
forall a. StuckF a -> Int
forall a. StuckF a -> [a]
forall a. (a -> a -> a) -> StuckF a -> a
forall m a. Monoid m => (a -> m) -> StuckF a -> m
forall b a. (b -> a -> b) -> b -> StuckF a -> b
forall a b. (a -> b -> b) -> b -> StuckF a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => StuckF a -> a
$cproduct :: forall a. Num a => StuckF a -> a
sum :: forall a. Num a => StuckF a -> a
$csum :: forall a. Num a => StuckF a -> a
minimum :: forall a. Ord a => StuckF a -> a
$cminimum :: forall a. Ord a => StuckF a -> a
maximum :: forall a. Ord a => StuckF a -> a
$cmaximum :: forall a. Ord a => StuckF a -> a
elem :: forall a. Eq a => a -> StuckF a -> Bool
$celem :: forall a. Eq a => a -> StuckF a -> Bool
length :: forall a. StuckF a -> Int
$clength :: forall a. StuckF a -> Int
null :: forall a. StuckF a -> Bool
$cnull :: forall a. StuckF a -> Bool
toList :: forall a. StuckF a -> [a]
$ctoList :: forall a. StuckF a -> [a]
foldl1 :: forall a. (a -> a -> a) -> StuckF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> StuckF a -> a
foldr1 :: forall a. (a -> a -> a) -> StuckF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> StuckF a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> StuckF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> StuckF a -> b
foldl :: forall b a. (b -> a -> b) -> b -> StuckF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> StuckF a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> StuckF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> StuckF a -> b
foldr :: forall a b. (a -> b -> b) -> b -> StuckF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> StuckF a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> StuckF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> StuckF a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> StuckF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> StuckF a -> m
fold :: forall m. Monoid m => StuckF m -> m
$cfold :: forall m. Monoid m => StuckF m -> m
Foldable, Functor StuckF
Foldable StuckF
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => StuckF (m a) -> m (StuckF a)
forall (f :: * -> *) a.
Applicative f =>
StuckF (f a) -> f (StuckF a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StuckF a -> m (StuckF b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StuckF a -> f (StuckF b)
sequence :: forall (m :: * -> *) a. Monad m => StuckF (m a) -> m (StuckF a)
$csequence :: forall (m :: * -> *) a. Monad m => StuckF (m a) -> m (StuckF a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StuckF a -> m (StuckF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StuckF a -> m (StuckF b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
StuckF (f a) -> f (StuckF a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
StuckF (f a) -> f (StuckF a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StuckF a -> f (StuckF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StuckF a -> f (StuckF b)
Traversable)

instance PrettyPrintable1 StuckF where
  showP1 :: forall a. PrettyPrintable a => StuckF a -> State Int String
showP1 = \case
    DeferSF FunctionIndex
ind a
x -> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. Semigroup a => a -> a -> a
(<>) (forall p. PrettyPrintable p => p -> State Int String
showP FunctionIndex
ind) (forall p. PrettyPrintable p => p -> State Int String
showP a
x)

instance Eq1 StuckF where
  liftEq :: forall a b. (a -> b -> Bool) -> StuckF a -> StuckF b -> Bool
liftEq a -> b -> Bool
test StuckF a
a StuckF b
b = case (StuckF a
a,StuckF b
b) of
    (DeferSF FunctionIndex
ix a
_, DeferSF FunctionIndex
iy b
_) | FunctionIndex
ix forall a. Eq a => a -> a -> Bool
== FunctionIndex
iy -> Bool
True -- test a b
    (StuckF a, StuckF b)
_                                       -> Bool
False

class BasicBase g where
  embedB :: PartExprF x -> g x
  extractB :: g x -> Maybe (PartExprF x)

class StuckBase g where
  embedS :: StuckF x -> g x
  extractS :: g x -> Maybe (StuckF x)

class SuperBase g where
  embedP :: SuperPositionF x -> g x
  extractP :: g x -> Maybe (SuperPositionF x)

class AbortBase g where
  embedA :: AbortableF x -> g x
  extractA :: g x -> Maybe (AbortableF x)

class UnsizedBase g where
  embedU :: UnsizedRecursionF x -> g x
  extractU :: g x -> Maybe (UnsizedRecursionF x)

pattern BasicFW :: BasicBase g => PartExprF x -> g x
pattern $mBasicFW :: forall {r} {g :: * -> *} {x}.
BasicBase g =>
g x -> (PartExprF x -> r) -> ((# #) -> r) -> r
BasicFW x <- (extractB -> Just x)
pattern BasicEE :: (Base g ~ f, BasicBase f, Recursive g) => PartExprF g -> g
pattern $mBasicEE :: forall {r} {g} {f :: * -> *}.
(Base g ~ f, BasicBase f, Recursive g) =>
g -> (PartExprF g -> r) -> ((# #) -> r) -> r
BasicEE x <- (project -> BasicFW x)
pattern StuckFW :: (StuckBase g) => StuckF x -> g x
pattern $mStuckFW :: forall {r} {g :: * -> *} {x}.
StuckBase g =>
g x -> (StuckF x -> r) -> ((# #) -> r) -> r
StuckFW x <- (extractS -> Just x)
pattern StuckEE :: (Base g ~ f, StuckBase f, Recursive g) => StuckF g -> g
pattern $mStuckEE :: forall {r} {g} {f :: * -> *}.
(Base g ~ f, StuckBase f, Recursive g) =>
g -> (StuckF g -> r) -> ((# #) -> r) -> r
StuckEE x <- (project -> StuckFW x)
pattern SuperFW :: SuperBase g => SuperPositionF x -> g x
pattern $mSuperFW :: forall {r} {g :: * -> *} {x}.
SuperBase g =>
g x -> (SuperPositionF x -> r) -> ((# #) -> r) -> r
SuperFW x <- (extractP -> Just x)
pattern SuperEE :: (Base g ~ f, SuperBase f, Recursive g) => SuperPositionF g -> g
pattern $mSuperEE :: forall {r} {g} {f :: * -> *}.
(Base g ~ f, SuperBase f, Recursive g) =>
g -> (SuperPositionF g -> r) -> ((# #) -> r) -> r
SuperEE x <- (project -> (SuperFW x))
pattern AbortFW :: AbortBase g => AbortableF x -> g x
pattern $mAbortFW :: forall {r} {g :: * -> *} {x}.
AbortBase g =>
g x -> (AbortableF x -> r) -> ((# #) -> r) -> r
AbortFW x <- (extractA -> Just x)
pattern AbortEE :: (Base g ~ f, AbortBase f, Recursive g) => AbortableF g -> g
pattern $mAbortEE :: forall {r} {g} {f :: * -> *}.
(Base g ~ f, AbortBase f, Recursive g) =>
g -> (AbortableF g -> r) -> ((# #) -> r) -> r
AbortEE x <- (project -> (AbortFW x))
pattern UnsizedFW :: UnsizedBase g => UnsizedRecursionF x -> g x
pattern $mUnsizedFW :: forall {r} {g :: * -> *} {x}.
UnsizedBase g =>
g x -> (UnsizedRecursionF x -> r) -> ((# #) -> r) -> r
UnsizedFW x <- (extractU -> Just x)
pattern UnsizedEE :: (Base g ~ f, UnsizedBase f, Recursive g) => UnsizedRecursionF g -> g
pattern $mUnsizedEE :: forall {r} {g} {f :: * -> *}.
(Base g ~ f, UnsizedBase f, Recursive g) =>
g -> (UnsizedRecursionF g -> r) -> ((# #) -> r) -> r
UnsizedEE x <- (project -> (UnsizedFW x))
basicEE :: (Base g ~ f, BasicBase f, Corecursive g) => PartExprF g -> g
basicEE :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE = forall t. Corecursive t => Base t t -> t
embed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB
stuckEE :: (Base g ~ f, StuckBase f, Corecursive g) => StuckF g -> g
stuckEE :: forall g (f :: * -> *).
(Base g ~ f, StuckBase f, Corecursive g) =>
StuckF g -> g
stuckEE = forall t. Corecursive t => Base t t -> t
embed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. StuckBase g => StuckF x -> g x
embedS
superEE :: (Base g ~ f, SuperBase f, Corecursive g) => SuperPositionF g -> g
superEE :: forall g (f :: * -> *).
(Base g ~ f, SuperBase f, Corecursive g) =>
SuperPositionF g -> g
superEE = forall t. Corecursive t => Base t t -> t
embed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. SuperBase g => SuperPositionF x -> g x
embedP
abortEE :: (Base g ~ f, AbortBase f, Corecursive g) => AbortableF g -> g
abortEE :: forall g (f :: * -> *).
(Base g ~ f, AbortBase f, Corecursive g) =>
AbortableF g -> g
abortEE = forall t. Corecursive t => Base t t -> t
embed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. AbortBase g => AbortableF x -> g x
embedA
unsizedEE :: (Base g ~ f, UnsizedBase f, Corecursive g) => UnsizedRecursionF g -> g
unsizedEE :: forall g (f :: * -> *).
(Base g ~ f, UnsizedBase f, Corecursive g) =>
UnsizedRecursionF g -> g
unsizedEE = forall t. Corecursive t => Base t t -> t
embed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. UnsizedBase g => UnsizedRecursionF x -> g x
embedU
zeroB :: (Base g ~ f, BasicBase f, Corecursive g) => g
zeroB :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g
zeroB = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall f. PartExprF f
ZeroSF
pairB :: (Base g ~ f, BasicBase f, Corecursive g) => g -> g -> g
pairB :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
pairB g
a g
b = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> PartExprF f
PairSF g
a g
b
envB :: (Base g ~ f, BasicBase f, Corecursive g) => g
envB :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g
envB = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall f. PartExprF f
EnvSF
setEnvB :: (Base g ~ f, BasicBase f, Corecursive g) => g -> g
setEnvB :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
setEnvB = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
SetEnvSF
gateB :: (Base g ~ f, BasicBase f, Corecursive g) => g -> g -> g
gateB :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
gateB g
l g
r = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> PartExprF f
GateSF g
l g
r
leftB :: (Base g ~ f, BasicBase f, Corecursive g) => g -> g
leftB :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
leftB = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
LeftSF
rightB :: (Base g ~ f, BasicBase f, Corecursive g) => g -> g
rightB :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
rightB = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
RightSF

pattern FillFunction :: (Base g ~ f, BasicBase f, Recursive g) => g -> g -> f g
pattern $mFillFunction :: forall {r} {g} {f :: * -> *}.
(Base g ~ f, BasicBase f, Recursive g) =>
f g -> (g -> g -> r) -> ((# #) -> r) -> r
FillFunction c e <- BasicFW (SetEnvSF (BasicEE (PairSF c e)))
pattern GateSwitch :: (Base g ~ f, BasicBase f, Recursive g) => g -> g -> g -> f g
pattern $mGateSwitch :: forall {r} {g} {f :: * -> *}.
(Base g ~ f, BasicBase f, Recursive g) =>
f g -> (g -> g -> g -> r) -> ((# #) -> r) -> r
GateSwitch l r s <- FillFunction (BasicEE (GateSF l r)) s

fillFunction :: (Base g ~ f, BasicBase f, Corecursive g) => g -> g -> g
fillFunction :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
fillFunction g
c g
e = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
setEnvB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
pairB g
c g
e)

gateSwitch :: (Base g ~ f, BasicBase f, Corecursive g) => g -> g -> g -> g
gateSwitch :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g -> g
gateSwitch  g
l g
r = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
fillFunction (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
gateB g
l g
r)

basicStep :: (Base g ~ f, BasicBase f, Corecursive g, Recursive g) => (f g -> g) -> f g -> g
basicStep :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g, Recursive g) =>
(f g -> g) -> f g -> g
basicStep f g -> g
handleOther = \case
  BasicFW (LeftSF z :: g
z@(BasicEE PartExprF g
ZeroSF))      -> g
z
  BasicFW (LeftSF (BasicEE (PairSF g
l g
_)))  -> g
l
  BasicFW (RightSF z :: g
z@(BasicEE PartExprF g
ZeroSF))     -> g
z
  BasicFW (RightSF (BasicEE (PairSF g
_ g
r))) -> g
r
  GateSwitch g
l g
_ (BasicEE PartExprF g
ZeroSF)          -> g
l
  GateSwitch g
_ g
r (BasicEE (PairSF g
_ g
_))    -> g
r
  -- stuck values
  x :: f g
x@(BasicFW PartExprF g
ZeroSF)                       -> forall t. Corecursive t => Base t t -> t
embed f g
x
  x :: f g
x@(BasicFW (PairSF g
_ g
_))                 -> forall t. Corecursive t => Base t t -> t
embed f g
x
  x :: f g
x@(BasicFW (GateSF g
_ g
_))                 -> forall t. Corecursive t => Base t t -> t
embed f g
x
  f g
x                                        -> f g -> g
handleOther f g
x

basicStepM :: (Base g ~ f, BasicBase f, Traversable f, Corecursive g, Recursive g, PrettyPrintable g, Monad m) => (f (m g) -> m g) -> f (m g) -> m g
basicStepM :: forall g (f :: * -> *) (m :: * -> *).
(Base g ~ f, BasicBase f, Traversable f, Corecursive g,
 Recursive g, PrettyPrintable g, Monad m) =>
(f (m g) -> m g) -> f (m g) -> m g
basicStepM f (m g) -> m g
handleOther f (m g)
x = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence f (m g)
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= f g -> m g
f where
  f :: f g -> m g
f = \case
    BasicFW (LeftSF z :: g
z@(BasicEE PartExprF g
ZeroSF))      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure g
z
    BasicFW (LeftSF (BasicEE (PairSF g
l g
_)))  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure g
l
    BasicFW (RightSF z :: g
z@(BasicEE PartExprF g
ZeroSF))     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure g
z
    BasicFW (RightSF (BasicEE (PairSF g
_ g
r))) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure g
r
    GateSwitch g
l g
_ (BasicEE PartExprF g
ZeroSF)          -> forall (f :: * -> *) a. Applicative f => a -> f a
pure g
l
    GateSwitch g
_ g
r (BasicEE (PairSF g
_ g
_))    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure g
r
    -- stuck values
    x :: f g
x@(BasicFW PartExprF g
ZeroSF)                       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t. Corecursive t => Base t t -> t
embed f g
x
    x :: f g
x@(BasicFW (PairSF g
_ g
_))                 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t. Corecursive t => Base t t -> t
embed f g
x
    x :: f g
x@(BasicFW (GateSF g
_ g
_))                 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t. Corecursive t => Base t t -> t
embed f g
x
    f g
_                                        -> f (m g) -> m g
handleOther f (m g)
x

transformNoDefer :: (Base g ~ f, StuckBase f, Recursive g) => (f g -> g) -> g -> g
transformNoDefer :: forall g (f :: * -> *).
(Base g ~ f, StuckBase f, Recursive g) =>
(f g -> g) -> g -> g
transformNoDefer f g -> g
f = g -> g
c where
  c :: g -> g
c = f g -> g
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. f g -> f g
c' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Recursive t => t -> Base t t
project
  c' :: f g -> f g
c' = \case
    s :: f g
s@(StuckFW (DeferSF FunctionIndex
_ g
_)) -> f g
s
    f g
x                         -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g -> g
c f g
x

transformNoDeferM :: (Base g ~ f, StuckBase f, Monad m, Recursive g) => (f (m g) -> m g) -> g -> m g
transformNoDeferM :: forall g (f :: * -> *) (m :: * -> *).
(Base g ~ f, StuckBase f, Monad m, Recursive g) =>
(f (m g) -> m g) -> g -> m g
transformNoDeferM f (m g) -> m g
f = g -> m g
c where
  c :: g -> m g
c = f (m g) -> m g
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. f g -> f (m g)
c' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Recursive t => t -> Base t t
project
  c' :: f g -> f (m g)
c' = \case
    s :: f g
s@(StuckFW (DeferSF FunctionIndex
_ g
_)) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure f g
s
    f g
x                         -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g -> m g
c f g
x

stuckStep :: (Base a ~ f, StuckBase f, BasicBase f, Recursive a, Corecursive a, PrettyPrintable a)
  => (f a -> a) -> f a -> a
stuckStep :: forall a (f :: * -> *).
(Base a ~ f, StuckBase f, BasicBase f, Recursive a, Corecursive a,
 PrettyPrintable a) =>
(f a -> a) -> f a -> a
stuckStep f a -> a
handleOther = \case
  ff :: f a
ff@(FillFunction (StuckEE (DeferSF FunctionIndex
fid a
d)) a
e) -> a -> a
db forall a b. (a -> b) -> a -> b
$ forall g (f :: * -> *).
(Base g ~ f, StuckBase f, Recursive g) =>
(f g -> g) -> g -> g
transformNoDefer (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g, Recursive g) =>
(f g -> g) -> f g -> g
basicStep (forall a (f :: * -> *).
(Base a ~ f, StuckBase f, BasicBase f, Recursive a, Corecursive a,
 PrettyPrintable a) =>
(f a -> a) -> f a -> a
stuckStep f a -> a
handleOther) forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Base a a
replaceEnv) a
d where
    e' :: Base a a
e' = forall t. Recursive t => t -> Base t t
project a
e
    db :: a -> a
db = if Bool
True -- fid == toEnum 5
      then forall a. String -> a -> a
debugTrace (String
"stuckstep dumping output:\n" forall a. Semigroup a => a -> a -> a
<> forall p. PrettyPrintable p => p -> String
prettyPrint (forall t. Corecursive t => Base t t -> t
embed f a
ff))
      else forall a. a -> a
id
    replaceEnv :: f a -> Base a a
replaceEnv = \case
      BasicFW PartExprF a
EnvSF -> Base a a
e'
      f a
x             -> f a
x
  -- stuck value
  x :: f a
x@(StuckFW StuckF a
_) -> forall t. Corecursive t => Base t t -> t
embed f a
x
  f a
x -> f a -> a
handleOther f a
x

stuckStepM :: (Base a ~ f, Traversable f, StuckBase f, BasicBase f, Recursive a, Corecursive a, PrettyPrintable a, Monad m)
  => (f (m a) -> m a) -> f (m a) -> m a
stuckStepM :: forall a (f :: * -> *) (m :: * -> *).
(Base a ~ f, Traversable f, StuckBase f, BasicBase f, Recursive a,
 Corecursive a, PrettyPrintable a, Monad m) =>
(f (m a) -> m a) -> f (m a) -> m a
stuckStepM f (m a) -> m a
handleOther f (m a)
x = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence f (m a)
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= f a -> m a
f where
  f :: f a -> m a
f = \case
    FillFunction (StuckEE (DeferSF FunctionIndex
fid a
d)) a
e -> forall g (f :: * -> *) (m :: * -> *).
(Base g ~ f, StuckBase f, Monad m, Recursive g) =>
(f (m g) -> m g) -> g -> m g
transformNoDeferM f (m a) -> m a
runStuck a
d where
      runStuck :: f (m a) -> m a
runStuck = forall g (f :: * -> *) (m :: * -> *).
(Base g ~ f, BasicBase f, Traversable f, Corecursive g,
 Recursive g, PrettyPrintable g, Monad m) =>
(f (m g) -> m g) -> f (m g) -> m g
basicStepM (forall a (f :: * -> *) (m :: * -> *).
(Base a ~ f, Traversable f, StuckBase f, BasicBase f, Recursive a,
 Corecursive a, PrettyPrintable a, Monad m) =>
(f (m a) -> m a) -> f (m a) -> m a
stuckStepM f (m a) -> m a
handleOther) forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (m a) -> f (m a)
replaceEnv
      e' :: f (m a)
e' = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Recursive t => t -> Base t t
project a
e
      replaceEnv :: f (m a) -> f (m a)
replaceEnv = \case
        BasicFW PartExprF (m a)
EnvSF -> f (m a)
e'
        f (m a)
x             -> f (m a)
x
    -- stuck value
    x :: f a
x@(StuckFW StuckF a
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t. Corecursive t => Base t t -> t
embed f a
x
    f a
_ -> f (m a) -> m a
handleOther f (m a)
x

evalBottomUp :: (Base t ~ f, BasicBase f, StuckBase f, Corecursive t, Recursive t, Recursive t) => (Base t t -> t) -> t -> t
evalBottomUp :: forall t (f :: * -> *).
(Base t ~ f, BasicBase f, StuckBase f, Corecursive t, Recursive t,
 Recursive t) =>
(Base t t -> t) -> t -> t
evalBottomUp Base t t -> t
handleOther = forall g (f :: * -> *).
(Base g ~ f, StuckBase f, Recursive g) =>
(f g -> g) -> g -> g
transformNoDefer (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g, Recursive g) =>
(f g -> g) -> f g -> g
basicStep Base t t -> t
handleOther)

superStep :: (Base a ~ f, BasicBase f, SuperBase f, Recursive a, Corecursive a, PrettyPrintable a)
  => (a -> a -> a) -> (f a -> a) -> (f a -> a) -> f a -> a
superStep :: forall a (f :: * -> *).
(Base a ~ f, BasicBase f, SuperBase f, Recursive a, Corecursive a,
 PrettyPrintable a) =>
(a -> a -> a) -> (f a -> a) -> (f a -> a) -> f a -> a
superStep a -> a -> a
mergeSuper f a -> a
step f a -> a
handleOther = \case
    BasicFW (LeftSF (SuperEE SuperPositionF a
AnyPF)) -> forall g (f :: * -> *).
(Base g ~ f, SuperBase f, Corecursive g) =>
SuperPositionF g -> g
superEE forall f. SuperPositionF f
AnyPF
    BasicFW (LeftSF (SuperEE (EitherPF a
a a
b))) -> a -> a -> a
mergeSuper (f a -> a
step forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
LeftSF forall a b. (a -> b) -> a -> b
$ a
a) (f a -> a
step forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
LeftSF forall a b. (a -> b) -> a -> b
$ a
b)
    BasicFW (RightSF (SuperEE SuperPositionF a
AnyPF)) -> forall g (f :: * -> *).
(Base g ~ f, SuperBase f, Corecursive g) =>
SuperPositionF g -> g
superEE forall f. SuperPositionF f
AnyPF
    BasicFW (RightSF (SuperEE (EitherPF a
a a
b))) -> a -> a -> a
mergeSuper (f a -> a
step forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
RightSF forall a b. (a -> b) -> a -> b
$ a
a) (f a -> a
step forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
RightSF forall a b. (a -> b) -> a -> b
$ a
b)
    BasicFW (SetEnvSF (SuperEE (EitherPF a
a a
b))) -> a -> a -> a
mergeSuper (f a -> a
step forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
SetEnvSF forall a b. (a -> b) -> a -> b
$ a
a) (f a -> a
step forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
SetEnvSF forall a b. (a -> b) -> a -> b
$ a
b)
    (GateSwitch a
l a
r (SuperEE SuperPositionF a
AnyPF)) -> a -> a -> a
mergeSuper a
l a
r
    GateSwitch a
l a
r x :: a
x@(SuperEE SuperPositionF a
_) -> if a -> Bool
containsZero a
x then a -> a -> a
mergeSuper a
l a
r else a
r where
      containsZero :: a -> Bool
containsZero = \case
        BasicEE PartExprF a
ZeroSF         -> Bool
True
        SuperEE (EitherPF a
a a
b) -> a -> Bool
containsZero a
a Bool -> Bool -> Bool
|| a -> Bool
containsZero a
b
        a
_                      -> Bool
False
    (FillFunction (SuperEE (EitherPF a
sca a
scb)) a
e) -> a -> a -> a
mergeSuper
      (f a -> a
step forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
SetEnvSF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> PartExprF f
PairSF a
sca a
e)
      (f a -> a
step forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
SetEnvSF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> PartExprF f
PairSF a
scb a
e)
    -- stuck values
    x :: f a
x@(SuperFW SuperPositionF a
AnyPF) -> forall t. Corecursive t => Base t t -> t
embed f a
x
    x :: f a
x@(SuperFW (EitherPF a
_ a
_)) -> forall t. Corecursive t => Base t t -> t
embed f a
x
    f a
x -> f a -> a
handleOther f a
x

superStepM :: (Base a ~ f, Traversable f, BasicBase f, SuperBase f, Recursive a, Corecursive a, PrettyPrintable a, Monad m)
  => (a -> a -> a) -> (f (m a) -> m a) -> (f (m a) -> m a) -> f (m a) -> m a
superStepM :: forall a (f :: * -> *) (m :: * -> *).
(Base a ~ f, Traversable f, BasicBase f, SuperBase f, Recursive a,
 Corecursive a, PrettyPrintable a, Monad m) =>
(a -> a -> a)
-> (f (m a) -> m a) -> (f (m a) -> m a) -> f (m a) -> m a
superStepM a -> a -> a
mergeSuper f (m a) -> m a
step f (m a) -> m a
handleOther f (m a)
x = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence f (m a)
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= f a -> m a
f where
  pbStep :: (a -> PartExprF a) -> a -> m a
pbStep a -> PartExprF a
bf = f (m a) -> m a
step forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PartExprF a
bf
  f :: f a -> m a
f = \case
    BasicFW (LeftSF (SuperEE SuperPositionF a
AnyPF)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall g (f :: * -> *).
(Base g ~ f, SuperBase f, Corecursive g) =>
SuperPositionF g -> g
superEE forall f. SuperPositionF f
AnyPF
    BasicFW (LeftSF (SuperEE (EitherPF a
a a
b))) -> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
mergeSuper ((a -> PartExprF a) -> a -> m a
pbStep forall f. f -> PartExprF f
LeftSF a
a) ((a -> PartExprF a) -> a -> m a
pbStep forall f. f -> PartExprF f
LeftSF a
b)
    BasicFW (RightSF (SuperEE SuperPositionF a
AnyPF)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall g (f :: * -> *).
(Base g ~ f, SuperBase f, Corecursive g) =>
SuperPositionF g -> g
superEE forall f. SuperPositionF f
AnyPF
    BasicFW (RightSF (SuperEE (EitherPF a
a a
b))) -> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
mergeSuper ((a -> PartExprF a) -> a -> m a
pbStep forall f. f -> PartExprF f
RightSF a
a) ((a -> PartExprF a) -> a -> m a
pbStep forall f. f -> PartExprF f
RightSF a
b)
    BasicFW (SetEnvSF (SuperEE (EitherPF a
a a
b))) -> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
mergeSuper ((a -> PartExprF a) -> a -> m a
pbStep forall f. f -> PartExprF f
SetEnvSF a
a) ((a -> PartExprF a) -> a -> m a
pbStep forall f. f -> PartExprF f
SetEnvSF a
b)
    GateSwitch a
l a
r (SuperEE SuperPositionF a
AnyPF) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ a -> a -> a
mergeSuper a
l a
r
    GateSwitch a
l a
r x :: a
x@(SuperEE SuperPositionF a
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if a -> Bool
containsZero a
x then a -> a -> a
mergeSuper a
l a
r else a
r where
      containsZero :: a -> Bool
containsZero = \case
        BasicEE PartExprF a
ZeroSF         -> Bool
True
        SuperEE (EitherPF a
a a
b) -> a -> Bool
containsZero a
a Bool -> Bool -> Bool
|| a -> Bool
containsZero a
b
        a
_                      -> Bool
False
    FillFunction (SuperEE (EitherPF a
sca a
scb)) a
e -> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
mergeSuper
      ((a -> PartExprF a) -> a -> m a
pbStep forall f. f -> PartExprF f
SetEnvSF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> PartExprF f
PairSF a
sca a
e)
      ((a -> PartExprF a) -> a -> m a
pbStep forall f. f -> PartExprF f
SetEnvSF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> PartExprF f
PairSF a
scb a
e)
    -- stuck values
    x :: f a
x@(SuperFW SuperPositionF a
AnyPF) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t. Corecursive t => Base t t -> t
embed f a
x
    x :: f a
x@(SuperFW (EitherPF a
_ a
_)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t. Corecursive t => Base t t -> t
embed f a
x
    f a
_ -> f (m a) -> m a
handleOther f (m a)
x

abortStep :: (Base a ~ f, BasicBase f, StuckBase f, AbortBase f, Recursive a, Corecursive a) => (f a -> a) -> f a -> a
abortStep :: forall a (f :: * -> *).
(Base a ~ f, BasicBase f, StuckBase f, AbortBase f, Recursive a,
 Corecursive a) =>
(f a -> a) -> f a -> a
abortStep f a -> a
handleOther =
  \case
    BasicFW (LeftSF a :: a
a@(AbortEE (AbortedF IExpr
_))) -> a
a
    BasicFW (RightSF a :: a
a@(AbortEE (AbortedF IExpr
_))) -> a
a
    BasicFW (SetEnvSF a :: a
a@(AbortEE (AbortedF IExpr
_))) -> a
a
    FillFunction a :: a
a@(AbortEE (AbortedF IExpr
_)) a
_ -> a
a
    GateSwitch a
_ a
_ a :: a
a@(AbortEE (AbortedF IExpr
_)) -> a
a
    FillFunction (AbortEE AbortableF a
AbortF) (BasicEE PartExprF a
ZeroSF) -> forall g (f :: * -> *).
(Base g ~ f, StuckBase f, Corecursive g) =>
StuckF g -> g
stuckEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. FunctionIndex -> f -> StuckF f
DeferSF FunctionIndex
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall a b. (a -> b) -> a -> b
$ forall f. PartExprF f
EnvSF where
      i :: FunctionIndex
i = forall a. Enum a => Int -> a
toEnum (-Int
1)
    -- BasicFW (FillFunction (AbortEE AbortF) (TwoEE AnyPF)) -> embed . ThreeFW . AbortedF $ AbortAny
    FillFunction (AbortEE AbortableF a
AbortF) e :: a
e@(BasicEE (PairSF a
_ a
_)) -> forall g (f :: * -> *).
(Base g ~ f, AbortBase f, Corecursive g) =>
AbortableF g -> g
abortEE forall a b. (a -> b) -> a -> b
$ forall f. IExpr -> AbortableF f
AbortedF IExpr
m where
      m :: IExpr
m = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata f IExpr -> IExpr
truncF a
e
      truncF :: f IExpr -> IExpr
truncF = \case
        BasicFW PartExprF IExpr
ZeroSF       -> IExpr
Zero
        BasicFW (PairSF IExpr
a IExpr
b) -> IExpr -> IExpr -> IExpr
Pair IExpr
a IExpr
b
        f IExpr
_                    -> IExpr
Zero -- consider generating a warning?
    -- stuck values
    x :: f a
x@(AbortFW (AbortedF IExpr
_)) -> forall t. Corecursive t => Base t t -> t
embed f a
x
    x :: f a
x@(AbortFW AbortableF a
AbortF) -> forall t. Corecursive t => Base t t -> t
embed f a
x
    f a
x -> f a -> a
handleOther f a
x

abortStepM :: (Base a ~ f, Traversable f, BasicBase f, StuckBase f, AbortBase f, Recursive a, Corecursive a, Monad m)
  => (f (m a) -> m a) -> f (m a) -> m a
abortStepM :: forall a (f :: * -> *) (m :: * -> *).
(Base a ~ f, Traversable f, BasicBase f, StuckBase f, AbortBase f,
 Recursive a, Corecursive a, Monad m) =>
(f (m a) -> m a) -> f (m a) -> m a
abortStepM f (m a) -> m a
handleOther f (m a)
x = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence f (m a)
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= f a -> m a
f where
  f :: f a -> m a
f = \case
    BasicFW (LeftSF a :: a
a@(AbortEE (AbortedF IExpr
_))) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    BasicFW (RightSF a :: a
a@(AbortEE (AbortedF IExpr
_))) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    BasicFW (SetEnvSF a :: a
a@(AbortEE (AbortedF IExpr
_))) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    FillFunction a :: a
a@(AbortEE (AbortedF IExpr
_)) a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    GateSwitch a
_ a
_ a :: a
a@(AbortEE (AbortedF IExpr
_)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    FillFunction (AbortEE AbortableF a
AbortF) (BasicEE PartExprF a
ZeroSF) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (f :: * -> *).
(Base g ~ f, StuckBase f, Corecursive g) =>
StuckF g -> g
stuckEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. FunctionIndex -> f -> StuckF f
DeferSF FunctionIndex
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall a b. (a -> b) -> a -> b
$ forall f. PartExprF f
EnvSF where
      i :: FunctionIndex
i = forall a. Enum a => Int -> a
toEnum (-Int
1)
    FillFunction (AbortEE AbortableF a
AbortF) e :: a
e@(BasicEE (PairSF a
_ a
_)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (f :: * -> *).
(Base g ~ f, AbortBase f, Corecursive g) =>
AbortableF g -> g
abortEE forall a b. (a -> b) -> a -> b
$ forall f. IExpr -> AbortableF f
AbortedF IExpr
m where
      m :: IExpr
m = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata f IExpr -> IExpr
truncF a
e
      truncF :: f IExpr -> IExpr
truncF = \case
        BasicFW PartExprF IExpr
ZeroSF       -> IExpr
Zero
        BasicFW (PairSF IExpr
a IExpr
b) -> IExpr -> IExpr -> IExpr
Pair IExpr
a IExpr
b
        f IExpr
_                    -> IExpr
Zero -- consider generating a warning?
    -- stuck values
    x :: f a
x@(AbortFW (AbortedF IExpr
_)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t. Corecursive t => Base t t -> t
embed f a
x
    x :: f a
x@(AbortFW AbortableF a
AbortF) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t. Corecursive t => Base t t -> t
embed f a
x
    f a
_ -> f (m a) -> m a
handleOther f (m a)
x

anyFunctionStep :: (Base a ~ f, BasicBase f, SuperBase f, Recursive a, Corecursive a) => (f a -> a) -> f a -> a
anyFunctionStep :: forall a (f :: * -> *).
(Base a ~ f, BasicBase f, SuperBase f, Recursive a,
 Corecursive a) =>
(f a -> a) -> f a -> a
anyFunctionStep f a -> a
handleOther =
  \case
    FillFunction a :: a
a@(SuperEE SuperPositionF a
AnyPF) a
_ -> a
a
    f a
x                                -> f a -> a
handleOther f a
x

anyFunctionStepM :: (Base a ~ f, Traversable f, BasicBase f, SuperBase f, Recursive a, Corecursive a, Monad m)
  => (f (m a) -> m a) -> f (m a) -> m a
anyFunctionStepM :: forall a (f :: * -> *) (m :: * -> *).
(Base a ~ f, Traversable f, BasicBase f, SuperBase f, Recursive a,
 Corecursive a, Monad m) =>
(f (m a) -> m a) -> f (m a) -> m a
anyFunctionStepM f (m a) -> m a
handleOther f (m a)
x = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence f (m a)
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= f a -> m a
f where
  f :: f a -> m a
f = \case
    FillFunction a :: a
a@(SuperEE SuperPositionF a
AnyPF) a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    f a
_                                -> f (m a) -> m a
handleOther f (m a)
x

newtype SizedRecursion = SizedRecursion { SizedRecursion -> Map UnsizedRecursionToken Int
unSizedRecursion :: Map UnsizedRecursionToken Int}

instance Semigroup SizedRecursion where
  <> :: SizedRecursion -> SizedRecursion -> SizedRecursion
(<>) (SizedRecursion Map UnsizedRecursionToken Int
a) (SizedRecursion Map UnsizedRecursionToken Int
b) = Map UnsizedRecursionToken Int -> SizedRecursion
SizedRecursion forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Ord a => a -> a -> a
max Map UnsizedRecursionToken Int
a Map UnsizedRecursionToken Int
b

instance Monoid SizedRecursion where
  mempty :: SizedRecursion
mempty = Map UnsizedRecursionToken Int -> SizedRecursion
SizedRecursion forall k a. Map k a
Map.empty

instance PrettyPrintable1 ((,) SizedRecursion) where
  showP1 :: forall a.
PrettyPrintable a =>
(SizedRecursion, a) -> State Int String
showP1 (SizedRecursion
_,a
x) = forall p. PrettyPrintable p => p -> State Int String
showP a
x

data StrictAccum a x = StrictAccum !a x
  deriving forall a b. a -> StrictAccum a b -> StrictAccum a a
forall a b. (a -> b) -> StrictAccum a a -> StrictAccum a b
forall a a b. a -> StrictAccum a b -> StrictAccum a a
forall a a b. (a -> b) -> StrictAccum a a -> StrictAccum a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> StrictAccum a b -> StrictAccum a a
$c<$ :: forall a a b. a -> StrictAccum a b -> StrictAccum a a
fmap :: forall a b. (a -> b) -> StrictAccum a a -> StrictAccum a b
$cfmap :: forall a a b. (a -> b) -> StrictAccum a a -> StrictAccum a b
Functor

instance Monoid a => Applicative (StrictAccum a) where
  pure :: forall a. a -> StrictAccum a a
pure = forall a x. a -> x -> StrictAccum a x
StrictAccum forall a. Monoid a => a
mempty
  StrictAccum a
u a -> b
f <*> :: forall a b.
StrictAccum a (a -> b) -> StrictAccum a a -> StrictAccum a b
<*> StrictAccum a
v a
x = forall a x. a -> x -> StrictAccum a x
StrictAccum (a
u forall a. Semigroup a => a -> a -> a
<> a
v) forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
  liftA2 :: forall a b c.
(a -> b -> c)
-> StrictAccum a a -> StrictAccum a b -> StrictAccum a c
liftA2 a -> b -> c
f (StrictAccum a
u a
x) (StrictAccum a
v b
y) = forall a x. a -> x -> StrictAccum a x
StrictAccum (a
u forall a. Semigroup a => a -> a -> a
<> a
v) forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
x b
y

instance Monoid a => Monad (StrictAccum a) where
  StrictAccum a
u a
x >>= :: forall a b.
StrictAccum a a -> (a -> StrictAccum a b) -> StrictAccum a b
>>= a -> StrictAccum a b
f = case a -> StrictAccum a b
f a
x of StrictAccum a
v b
y -> forall a x. a -> x -> StrictAccum a x
StrictAccum (a
u forall a. Semigroup a => a -> a -> a
<> a
v) b
y

instance PrettyPrintable1 (StrictAccum SizedRecursion) where
  showP1 :: forall a.
PrettyPrintable a =>
StrictAccum SizedRecursion a -> State Int String
showP1 (StrictAccum SizedRecursion
_ a
x) = forall p. PrettyPrintable p => p -> State Int String
showP a
x

unsizedStepM :: (Base a ~ f, Traversable f, BasicBase f, StuckBase f, SuperBase f, AbortBase f, UnsizedBase f, Recursive a, Corecursive a, Eq a, PrettyPrintable a)
  => Int -> (f (StrictAccum SizedRecursion a) -> StrictAccum SizedRecursion a) -> (f (StrictAccum SizedRecursion a) -> StrictAccum SizedRecursion a)
  -> f (StrictAccum SizedRecursion a) -> StrictAccum SizedRecursion a
unsizedStepM :: forall a (f :: * -> *).
(Base a ~ f, Traversable f, BasicBase f, StuckBase f, SuperBase f,
 AbortBase f, UnsizedBase f, Recursive a, Corecursive a, Eq a,
 PrettyPrintable a) =>
Int
-> (f (StrictAccum SizedRecursion a)
    -> StrictAccum SizedRecursion a)
-> (f (StrictAccum SizedRecursion a)
    -> StrictAccum SizedRecursion a)
-> f (StrictAccum SizedRecursion a)
-> StrictAccum SizedRecursion a
unsizedStepM Int
maxSize f (StrictAccum SizedRecursion a) -> StrictAccum SizedRecursion a
fullStep f (StrictAccum SizedRecursion a) -> StrictAccum SizedRecursion a
handleOther f (StrictAccum SizedRecursion a)
x = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence f (StrictAccum SizedRecursion a)
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= f a -> StrictAccum SizedRecursion a
f where
  f :: f a -> StrictAccum SizedRecursion a
f = \case
    UnsizedFW (SizingWrapperF UnsizedRecursionToken
tok (BasicEE (PairSF a
d (BasicEE (PairSF a
b (BasicEE (PairSF a
r (BasicEE (PairSF a
tp (BasicEE PartExprF a
ZeroSF))))))))))
      -> case a
tp of
            BasicEE (PairSF (StuckEE (DeferSF FunctionIndex
sid a
tf)) a
e) ->
              let nt :: a
nt = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
pairB (forall g (f :: * -> *).
(Base g ~ f, StuckBase f, Corecursive g) =>
StuckF g -> g
stuckEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. FunctionIndex -> f -> StuckF f
DeferSF FunctionIndex
sid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (f :: * -> *).
(Base g ~ f, UnsizedBase f, Corecursive g) =>
UnsizedRecursionF g -> g
unsizedEE forall a b. (a -> b) -> a -> b
$ forall f. UnsizedRecursionToken -> f -> UnsizedRecursionF f
RecursionTestF UnsizedRecursionToken
tok a
tf) a
e
                  trb :: a
trb = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
pairB a
b (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
pairB a
r (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
pairB a
nt forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g
zeroB))
                  fi :: FunctionIndex
fi = forall a. Enum a => Int -> a
toEnum (-Int
1)
                  argOne :: a
argOne = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
leftB forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g
envB
                  argTwo :: a
argTwo = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
leftB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
rightB forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g
envB)
                  argThree :: a
argThree = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
leftB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
rightB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
rightB forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g
envB))
                  argFour :: a
argFour = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
leftB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
rightB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
rightB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
rightB forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g
envB)))
                  argFive :: a
argFive = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
leftB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
rightB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
rightB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
rightB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
rightB forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g
envB))))
                  deferB :: a -> a
deferB = forall g (f :: * -> *).
(Base g ~ f, StuckBase f, Corecursive g) =>
StuckF g -> g
stuckEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. FunctionIndex -> f -> StuckF f
DeferSF FunctionIndex
fi
                  iteB :: a -> a -> a -> a
iteB a
i a
t a
e = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
fillFunction (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
fillFunction (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
gateB (a -> a
deferB a
e) (a -> a
deferB a
t)) a
i) forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g
envB -- TODO THIS IS HOW TO DO LAZY IF/ELSE, COPY!
                  twiddle :: a
twiddle = a -> a
deferB forall a b. (a -> b) -> a -> b
$ forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
pairB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
leftB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
rightB forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g
envB)) (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
pairB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
leftB forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g
envB) (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
rightB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
rightB forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g
envB)))
                  appB :: a -> a -> a
appB a
c a
i = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
setEnvB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g
setEnvB (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
pairB a
twiddle (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
pairB a
i a
c)))
                  lamB :: a -> a
lamB a
x = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
pairB (a -> a
deferB a
x) forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g
envB
                  abrt :: a
abrt = a -> a
lamB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (f :: * -> *).
(Base g ~ f, AbortBase f, Corecursive g) =>
AbortableF g -> g
abortEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. IExpr -> AbortableF f
AbortedF forall a b. (a -> b) -> a -> b
$ IExpr
AbortRecursion
                  rf :: Int -> a
rf Int
n = a -> a
lamB (a -> a
lamB (forall g (f :: * -> *).
(Base g ~ f, UnsizedBase f, Corecursive g) =>
UnsizedRecursionF g -> g
unsizedEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. UnsizedRecursionToken -> Int -> f -> UnsizedRecursionF f
SizeStageF UnsizedRecursionToken
tok Int
n forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a
iteB (a -> a -> a
appB a
argFive a
argOne)
                                                                         (a -> a -> a
appB (a -> a -> a
appB a
argFour a
argTwo) a
argOne)
                                                                         (a -> a -> a
appB a
argThree a
argOne)))
                  -- rf' n = appB (rf n) (rf' (n + 1))
                  rf' :: Int -> a
rf' Int
n = if Int
n forall a. Ord a => a -> a -> Bool
> Int
maxSize
                    -- then error "reached recursion limit"
                    -- then argThree
                    then a
abrt
                    else a -> a -> a
appB (Int -> a
rf Int
n) (Int -> a
rf' (Int
n forall a. Num a => a -> a -> a
+ Int
1))
              in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
g -> g -> g
pairB (a -> a
deferB forall a b. (a -> b) -> a -> b
$ Int -> a
rf' Int
1) a
trb
    UnsizedFW (RecursionTestF UnsizedRecursionToken
ri a
x) ->
      let test :: a -> a
test = \case
            z :: a
z@(BasicEE PartExprF a
ZeroSF) -> a
z
            p :: a
p@(BasicEE (PairSF a
_ a
_)) -> a
p
            SuperEE SuperPositionF a
AnyPF -> forall g (f :: * -> *).
(Base g ~ f, AbortBase f, Corecursive g) =>
AbortableF g -> g
abortEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. IExpr -> AbortableF f
AbortedF forall b c a. (b -> c) -> (a -> b) -> a -> c
. IExpr -> IExpr
AbortUnsizeable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IExpr
i2g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ UnsizedRecursionToken
ri
            SuperEE (EitherPF a
a a
b) -> forall g (f :: * -> *).
(Base g ~ f, SuperBase f, Corecursive g) =>
SuperPositionF g -> g
superEE forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> SuperPositionF f
EitherPF (a -> a
test a
a) (a -> a
test a
b)
            a :: a
a@(AbortEE (AbortedF IExpr
_)) -> a
a
            a
z -> forall a. HasCallStack => String -> a
error (String
"evalRecursionTest checkTest unexpected\n" forall a. Semigroup a => a -> a -> a
<> forall p. PrettyPrintable p => p -> String
prettyPrint a
z)
      in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ a -> a
test a
x
    UnsizedFW (SizeStageF UnsizedRecursionToken
urt Int
n a
x) -> forall a. String -> a -> a
debugTrace (String
"hit sizing at " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (UnsizedRecursionToken
urt, Int
n)) forall a x. a -> x -> StrictAccum a x
StrictAccum (Map UnsizedRecursionToken Int -> SizedRecursion
SizedRecursion forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton UnsizedRecursionToken
urt Int
n) a
x
    -- stuck value
    t :: f a
t@(UnsizedFW (RecursionTestF UnsizedRecursionToken
_ a
_)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t. Corecursive t => Base t t -> t
embed f a
t
    f a
_ -> f (StrictAccum SizedRecursion a) -> StrictAccum SizedRecursion a
handleOther f (StrictAccum SizedRecursion a)
x

data VoidF f
  deriving (forall a b. a -> VoidF b -> VoidF a
forall a b. (a -> b) -> VoidF a -> VoidF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> VoidF b -> VoidF a
$c<$ :: forall a b. a -> VoidF b -> VoidF a
fmap :: forall a b. (a -> b) -> VoidF a -> VoidF b
$cfmap :: forall a b. (a -> b) -> VoidF a -> VoidF b
Functor, forall a. Eq a => a -> VoidF a -> Bool
forall a. Num a => VoidF a -> a
forall a. Ord a => VoidF a -> a
forall m. Monoid m => VoidF m -> m
forall a. VoidF a -> Bool
forall a. VoidF a -> Int
forall a. VoidF a -> [a]
forall a. (a -> a -> a) -> VoidF a -> a
forall m a. Monoid m => (a -> m) -> VoidF a -> m
forall b a. (b -> a -> b) -> b -> VoidF a -> b
forall a b. (a -> b -> b) -> b -> VoidF a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => VoidF a -> a
$cproduct :: forall a. Num a => VoidF a -> a
sum :: forall a. Num a => VoidF a -> a
$csum :: forall a. Num a => VoidF a -> a
minimum :: forall a. Ord a => VoidF a -> a
$cminimum :: forall a. Ord a => VoidF a -> a
maximum :: forall a. Ord a => VoidF a -> a
$cmaximum :: forall a. Ord a => VoidF a -> a
elem :: forall a. Eq a => a -> VoidF a -> Bool
$celem :: forall a. Eq a => a -> VoidF a -> Bool
length :: forall a. VoidF a -> Int
$clength :: forall a. VoidF a -> Int
null :: forall a. VoidF a -> Bool
$cnull :: forall a. VoidF a -> Bool
toList :: forall a. VoidF a -> [a]
$ctoList :: forall a. VoidF a -> [a]
foldl1 :: forall a. (a -> a -> a) -> VoidF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> VoidF a -> a
foldr1 :: forall a. (a -> a -> a) -> VoidF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> VoidF a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> VoidF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> VoidF a -> b
foldl :: forall b a. (b -> a -> b) -> b -> VoidF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> VoidF a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> VoidF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> VoidF a -> b
foldr :: forall a b. (a -> b -> b) -> b -> VoidF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> VoidF a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> VoidF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> VoidF a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> VoidF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> VoidF a -> m
fold :: forall m. Monoid m => VoidF m -> m
$cfold :: forall m. Monoid m => VoidF m -> m
Foldable, Functor VoidF
Foldable VoidF
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => VoidF (m a) -> m (VoidF a)
forall (f :: * -> *) a. Applicative f => VoidF (f a) -> f (VoidF a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> VoidF a -> m (VoidF b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> VoidF a -> f (VoidF b)
sequence :: forall (m :: * -> *) a. Monad m => VoidF (m a) -> m (VoidF a)
$csequence :: forall (m :: * -> *) a. Monad m => VoidF (m a) -> m (VoidF a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> VoidF a -> m (VoidF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> VoidF a -> m (VoidF b)
sequenceA :: forall (f :: * -> *) a. Applicative f => VoidF (f a) -> f (VoidF a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => VoidF (f a) -> f (VoidF a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> VoidF a -> f (VoidF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> VoidF a -> f (VoidF b)
Traversable)

instance Eq1 VoidF where
  liftEq :: forall a b. (a -> b -> Bool) -> VoidF a -> VoidF b -> Bool
liftEq a -> b -> Bool
test VoidF a
a VoidF b
b = forall a. HasCallStack => a
undefined

instance Show1 VoidF where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> VoidF a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrec [a] -> ShowS
showList Int
prec VoidF a
x = forall a. HasCallStack => a
undefined

data SuperPositionF f
  = EitherPF !f !f
  | AnyPF
  deriving (SuperPositionF f -> SuperPositionF f -> Bool
forall f. Eq f => SuperPositionF f -> SuperPositionF f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SuperPositionF f -> SuperPositionF f -> Bool
$c/= :: forall f. Eq f => SuperPositionF f -> SuperPositionF f -> Bool
== :: SuperPositionF f -> SuperPositionF f -> Bool
$c== :: forall f. Eq f => SuperPositionF f -> SuperPositionF f -> Bool
Eq, SuperPositionF f -> SuperPositionF f -> Bool
SuperPositionF f -> SuperPositionF f -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {f}. Ord f => Eq (SuperPositionF f)
forall f. Ord f => SuperPositionF f -> SuperPositionF f -> Bool
forall f. Ord f => SuperPositionF f -> SuperPositionF f -> Ordering
forall f.
Ord f =>
SuperPositionF f -> SuperPositionF f -> SuperPositionF f
min :: SuperPositionF f -> SuperPositionF f -> SuperPositionF f
$cmin :: forall f.
Ord f =>
SuperPositionF f -> SuperPositionF f -> SuperPositionF f
max :: SuperPositionF f -> SuperPositionF f -> SuperPositionF f
$cmax :: forall f.
Ord f =>
SuperPositionF f -> SuperPositionF f -> SuperPositionF f
>= :: SuperPositionF f -> SuperPositionF f -> Bool
$c>= :: forall f. Ord f => SuperPositionF f -> SuperPositionF f -> Bool
> :: SuperPositionF f -> SuperPositionF f -> Bool
$c> :: forall f. Ord f => SuperPositionF f -> SuperPositionF f -> Bool
<= :: SuperPositionF f -> SuperPositionF f -> Bool
$c<= :: forall f. Ord f => SuperPositionF f -> SuperPositionF f -> Bool
< :: SuperPositionF f -> SuperPositionF f -> Bool
$c< :: forall f. Ord f => SuperPositionF f -> SuperPositionF f -> Bool
compare :: SuperPositionF f -> SuperPositionF f -> Ordering
$ccompare :: forall f. Ord f => SuperPositionF f -> SuperPositionF f -> Ordering
Ord, Int -> SuperPositionF f -> ShowS
forall f. Show f => Int -> SuperPositionF f -> ShowS
forall f. Show f => [SuperPositionF f] -> ShowS
forall f. Show f => SuperPositionF f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SuperPositionF f] -> ShowS
$cshowList :: forall f. Show f => [SuperPositionF f] -> ShowS
show :: SuperPositionF f -> String
$cshow :: forall f. Show f => SuperPositionF f -> String
showsPrec :: Int -> SuperPositionF f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> SuperPositionF f -> ShowS
Show, forall a b. a -> SuperPositionF b -> SuperPositionF a
forall a b. (a -> b) -> SuperPositionF a -> SuperPositionF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SuperPositionF b -> SuperPositionF a
$c<$ :: forall a b. a -> SuperPositionF b -> SuperPositionF a
fmap :: forall a b. (a -> b) -> SuperPositionF a -> SuperPositionF b
$cfmap :: forall a b. (a -> b) -> SuperPositionF a -> SuperPositionF b
Functor, forall a. Eq a => a -> SuperPositionF a -> Bool
forall a. Num a => SuperPositionF a -> a
forall a. Ord a => SuperPositionF a -> a
forall m. Monoid m => SuperPositionF m -> m
forall a. SuperPositionF a -> Bool
forall a. SuperPositionF a -> Int
forall a. SuperPositionF a -> [a]
forall a. (a -> a -> a) -> SuperPositionF a -> a
forall m a. Monoid m => (a -> m) -> SuperPositionF a -> m
forall b a. (b -> a -> b) -> b -> SuperPositionF a -> b
forall a b. (a -> b -> b) -> b -> SuperPositionF a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => SuperPositionF a -> a
$cproduct :: forall a. Num a => SuperPositionF a -> a
sum :: forall a. Num a => SuperPositionF a -> a
$csum :: forall a. Num a => SuperPositionF a -> a
minimum :: forall a. Ord a => SuperPositionF a -> a
$cminimum :: forall a. Ord a => SuperPositionF a -> a
maximum :: forall a. Ord a => SuperPositionF a -> a
$cmaximum :: forall a. Ord a => SuperPositionF a -> a
elem :: forall a. Eq a => a -> SuperPositionF a -> Bool
$celem :: forall a. Eq a => a -> SuperPositionF a -> Bool
length :: forall a. SuperPositionF a -> Int
$clength :: forall a. SuperPositionF a -> Int
null :: forall a. SuperPositionF a -> Bool
$cnull :: forall a. SuperPositionF a -> Bool
toList :: forall a. SuperPositionF a -> [a]
$ctoList :: forall a. SuperPositionF a -> [a]
foldl1 :: forall a. (a -> a -> a) -> SuperPositionF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SuperPositionF a -> a
foldr1 :: forall a. (a -> a -> a) -> SuperPositionF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> SuperPositionF a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> SuperPositionF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SuperPositionF a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SuperPositionF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SuperPositionF a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SuperPositionF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SuperPositionF a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SuperPositionF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> SuperPositionF a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> SuperPositionF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SuperPositionF a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SuperPositionF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SuperPositionF a -> m
fold :: forall m. Monoid m => SuperPositionF m -> m
$cfold :: forall m. Monoid m => SuperPositionF m -> m
Foldable, Functor SuperPositionF
Foldable SuperPositionF
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SuperPositionF (m a) -> m (SuperPositionF a)
forall (f :: * -> *) a.
Applicative f =>
SuperPositionF (f a) -> f (SuperPositionF a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SuperPositionF a -> m (SuperPositionF b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SuperPositionF a -> f (SuperPositionF b)
sequence :: forall (m :: * -> *) a.
Monad m =>
SuperPositionF (m a) -> m (SuperPositionF a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SuperPositionF (m a) -> m (SuperPositionF a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SuperPositionF a -> m (SuperPositionF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SuperPositionF a -> m (SuperPositionF b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SuperPositionF (f a) -> f (SuperPositionF a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SuperPositionF (f a) -> f (SuperPositionF a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SuperPositionF a -> f (SuperPositionF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SuperPositionF a -> f (SuperPositionF b)
Traversable)

instance Eq1 SuperPositionF where
  liftEq :: forall a b.
(a -> b -> Bool) -> SuperPositionF a -> SuperPositionF b -> Bool
liftEq a -> b -> Bool
test SuperPositionF a
a SuperPositionF b
b = case (SuperPositionF a
a,SuperPositionF b
b) of
    (SuperPositionF a
AnyPF, SuperPositionF b
AnyPF)               -> Bool
True
    (EitherPF a
a a
b, EitherPF b
c b
d) -> a -> b -> Bool
test a
a b
c Bool -> Bool -> Bool
&& a -> b -> Bool
test a
b b
d
    (SuperPositionF a, SuperPositionF b)
_                            -> Bool
False

instance Show1 SuperPositionF where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> SuperPositionF a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrec [a] -> ShowS
showList Int
prec = \case
    EitherPF a
a a
b -> forall a. Show a => a -> ShowS
shows String
"EitherPF (" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showsPrec Int
0 a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showsPrec Int
0 a
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
")"
    SuperPositionF a
AnyPF -> forall a. Show a => a -> ShowS
shows String
"AnyPF"

-- TODO we can simplify abort semantics to (defer env), and then could do gate x (abort [message] x) for conditional abort
data AbortableF f
  = AbortF
  | AbortedF IExpr
  deriving (AbortableF f -> AbortableF f -> Bool
forall f. AbortableF f -> AbortableF f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbortableF f -> AbortableF f -> Bool
$c/= :: forall f. AbortableF f -> AbortableF f -> Bool
== :: AbortableF f -> AbortableF f -> Bool
$c== :: forall f. AbortableF f -> AbortableF f -> Bool
Eq, AbortableF f -> AbortableF f -> Bool
AbortableF f -> AbortableF f -> Ordering
forall f. Eq (AbortableF f)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall f. AbortableF f -> AbortableF f -> Bool
forall f. AbortableF f -> AbortableF f -> Ordering
forall f. AbortableF f -> AbortableF f -> AbortableF f
min :: AbortableF f -> AbortableF f -> AbortableF f
$cmin :: forall f. AbortableF f -> AbortableF f -> AbortableF f
max :: AbortableF f -> AbortableF f -> AbortableF f
$cmax :: forall f. AbortableF f -> AbortableF f -> AbortableF f
>= :: AbortableF f -> AbortableF f -> Bool
$c>= :: forall f. AbortableF f -> AbortableF f -> Bool
> :: AbortableF f -> AbortableF f -> Bool
$c> :: forall f. AbortableF f -> AbortableF f -> Bool
<= :: AbortableF f -> AbortableF f -> Bool
$c<= :: forall f. AbortableF f -> AbortableF f -> Bool
< :: AbortableF f -> AbortableF f -> Bool
$c< :: forall f. AbortableF f -> AbortableF f -> Bool
compare :: AbortableF f -> AbortableF f -> Ordering
$ccompare :: forall f. AbortableF f -> AbortableF f -> Ordering
Ord, Int -> AbortableF f -> ShowS
forall f. Int -> AbortableF f -> ShowS
forall f. [AbortableF f] -> ShowS
forall f. AbortableF f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbortableF f] -> ShowS
$cshowList :: forall f. [AbortableF f] -> ShowS
show :: AbortableF f -> String
$cshow :: forall f. AbortableF f -> String
showsPrec :: Int -> AbortableF f -> ShowS
$cshowsPrec :: forall f. Int -> AbortableF f -> ShowS
Show, forall a b. a -> AbortableF b -> AbortableF a
forall a b. (a -> b) -> AbortableF a -> AbortableF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AbortableF b -> AbortableF a
$c<$ :: forall a b. a -> AbortableF b -> AbortableF a
fmap :: forall a b. (a -> b) -> AbortableF a -> AbortableF b
$cfmap :: forall a b. (a -> b) -> AbortableF a -> AbortableF b
Functor, forall a. Eq a => a -> AbortableF a -> Bool
forall a. Num a => AbortableF a -> a
forall a. Ord a => AbortableF a -> a
forall m. Monoid m => AbortableF m -> m
forall a. AbortableF a -> Bool
forall a. AbortableF a -> Int
forall a. AbortableF a -> [a]
forall a. (a -> a -> a) -> AbortableF a -> a
forall m a. Monoid m => (a -> m) -> AbortableF a -> m
forall b a. (b -> a -> b) -> b -> AbortableF a -> b
forall a b. (a -> b -> b) -> b -> AbortableF a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => AbortableF a -> a
$cproduct :: forall a. Num a => AbortableF a -> a
sum :: forall a. Num a => AbortableF a -> a
$csum :: forall a. Num a => AbortableF a -> a
minimum :: forall a. Ord a => AbortableF a -> a
$cminimum :: forall a. Ord a => AbortableF a -> a
maximum :: forall a. Ord a => AbortableF a -> a
$cmaximum :: forall a. Ord a => AbortableF a -> a
elem :: forall a. Eq a => a -> AbortableF a -> Bool
$celem :: forall a. Eq a => a -> AbortableF a -> Bool
length :: forall a. AbortableF a -> Int
$clength :: forall a. AbortableF a -> Int
null :: forall a. AbortableF a -> Bool
$cnull :: forall a. AbortableF a -> Bool
toList :: forall a. AbortableF a -> [a]
$ctoList :: forall a. AbortableF a -> [a]
foldl1 :: forall a. (a -> a -> a) -> AbortableF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> AbortableF a -> a
foldr1 :: forall a. (a -> a -> a) -> AbortableF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> AbortableF a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> AbortableF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> AbortableF a -> b
foldl :: forall b a. (b -> a -> b) -> b -> AbortableF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> AbortableF a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> AbortableF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> AbortableF a -> b
foldr :: forall a b. (a -> b -> b) -> b -> AbortableF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> AbortableF a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> AbortableF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> AbortableF a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> AbortableF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> AbortableF a -> m
fold :: forall m. Monoid m => AbortableF m -> m
$cfold :: forall m. Monoid m => AbortableF m -> m
Foldable, Functor AbortableF
Foldable AbortableF
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
AbortableF (m a) -> m (AbortableF a)
forall (f :: * -> *) a.
Applicative f =>
AbortableF (f a) -> f (AbortableF a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AbortableF a -> m (AbortableF b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AbortableF a -> f (AbortableF b)
sequence :: forall (m :: * -> *) a.
Monad m =>
AbortableF (m a) -> m (AbortableF a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
AbortableF (m a) -> m (AbortableF a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AbortableF a -> m (AbortableF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AbortableF a -> m (AbortableF b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
AbortableF (f a) -> f (AbortableF a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
AbortableF (f a) -> f (AbortableF a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AbortableF a -> f (AbortableF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AbortableF a -> f (AbortableF b)
Traversable)

instance Eq1 AbortableF  where
  liftEq :: forall a b.
(a -> b -> Bool) -> AbortableF a -> AbortableF b -> Bool
liftEq a -> b -> Bool
test AbortableF a
a AbortableF b
b = case (AbortableF a
a,AbortableF b
b) of
    (AbortableF a
AbortF, AbortableF b
AbortF)                  -> Bool
True
    (AbortedF IExpr
a, AbortedF IExpr
b) | IExpr
a forall a. Eq a => a -> a -> Bool
== IExpr
b -> Bool
True
    (AbortableF a, AbortableF b)
_                                 -> Bool
False

instance Show1 AbortableF where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> AbortableF a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrec [a] -> ShowS
showList Int
prec = \case
    AbortableF a
AbortF     -> forall a. Show a => a -> ShowS
shows String
"AbortF"
    AbortedF IExpr
x -> forall a. Show a => a -> ShowS
shows String
"(AbortedF " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows IExpr
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
")"

mergeBasic :: (Base x ~ f, BasicBase f, Eq x, Corecursive x, Recursive x) => (x -> x -> x) -> x -> x -> x
mergeBasic :: forall x (f :: * -> *).
(Base x ~ f, BasicBase f, Eq x, Corecursive x, Recursive x) =>
(x -> x -> x) -> x -> x -> x
mergeBasic x -> x -> x
mergeOther x
a x
b =
  let reMerge :: x -> x -> x
reMerge = forall x (f :: * -> *).
(Base x ~ f, BasicBase f, Eq x, Corecursive x, Recursive x) =>
(x -> x -> x) -> x -> x -> x
mergeBasic x -> x -> x
mergeOther
  in case (x
a,x
b) of
    {-
    (BasicEE (PairSF a b), BasicEE (PairSF c d)) | a == c -> basicEE $ PairSF a (reMerge b d)
    (BasicEE (PairSF a b), BasicEE (PairSF c d)) | b == d -> basicEE $ PairSF (reMerge a c) b
    (BasicEE (GateSF a b), BasicEE (GateSF c d)) | a == c -> basicEE $ GateSF a (reMerge b d)
    (BasicEE (GateSF a b), BasicEE (GateSF c d)) | b == d -> basicEE $ GateSF (reMerge a c) b
    (BasicEE (LeftSF x), BasicEE (LeftSF y)) -> basicEE . LeftSF $ reMerge x y
    (BasicEE (RightSF x), BasicEE (RightSF y)) -> basicEE . RightSF $ reMerge x y
-}
    (BasicEE PartExprF x
ZeroSF, BasicEE PartExprF x
ZeroSF) -> forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall f. PartExprF f
ZeroSF
    (x, x)
_                                -> x -> x -> x
mergeOther x
a x
b

mergeStuck :: (Base x ~ f, StuckBase f, Recursive x) => (x -> x -> x) -> x -> x -> x
mergeStuck :: forall x (f :: * -> *).
(Base x ~ f, StuckBase f, Recursive x) =>
(x -> x -> x) -> x -> x -> x
mergeStuck x -> x -> x
mergeOther x
a x
b =
  case (x
a,x
b) of
    -- should we try merging within functions? Probably not
    (s :: x
s@(StuckEE (DeferSF FunctionIndex
fida x
_)), StuckEE (DeferSF FunctionIndex
fidb x
_)) | FunctionIndex
fida forall a. Eq a => a -> a -> Bool
== FunctionIndex
fidb -> x
s
    (x, x)
_ -> x -> x -> x
mergeOther x
a x
b

mergeSuper :: (Base x ~ f, SuperBase f, Eq x, Corecursive x, Recursive x) => (x -> x -> x) -> (x -> x -> x) -> x -> x -> x
mergeSuper :: forall x (f :: * -> *).
(Base x ~ f, SuperBase f, Eq x, Corecursive x, Recursive x) =>
(x -> x -> x) -> (x -> x -> x) -> x -> x -> x
mergeSuper x -> x -> x
reMerge x -> x -> x
mergeOther x
a x
b = case (x
a,x
b) of
  (s :: x
s@(SuperEE SuperPositionF x
AnyPF), x
_)      -> x
s
  (x
_, s :: x
s@(SuperEE SuperPositionF x
AnyPF))      -> x
s
  (SuperEE (EitherPF x
a x
b), x
c) -> forall g (f :: * -> *).
(Base g ~ f, SuperBase f, Corecursive g) =>
SuperPositionF g -> g
superEE forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> SuperPositionF f
EitherPF (x -> x -> x
reMerge x
a x
c) (x -> x -> x
reMerge x
b x
c)
  (x
a, SuperEE (EitherPF x
b x
c)) -> forall g (f :: * -> *).
(Base g ~ f, SuperBase f, Corecursive g) =>
SuperPositionF g -> g
superEE forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> SuperPositionF f
EitherPF (x -> x -> x
reMerge x
a x
b) (x -> x -> x
reMerge x
a x
c)
  (x, x)
_                           -> x -> x -> x
mergeOther x
a x
b

mergeAbort :: (Base x ~ f, AbortBase f, Eq x, Corecursive x, Recursive x) => (x -> x -> x) -> x -> x -> x
mergeAbort :: forall x (f :: * -> *).
(Base x ~ f, AbortBase f, Eq x, Corecursive x, Recursive x) =>
(x -> x -> x) -> x -> x -> x
mergeAbort x -> x -> x
mergeOther x
a x
b =
  case (x
a,x
b) of
    (a :: x
a@(AbortEE (AbortedF IExpr
x)), AbortEE (AbortedF IExpr
y)) | IExpr
x forall a. Eq a => a -> a -> Bool
== IExpr
y -> x
a
    (a :: x
a@(AbortEE AbortableF x
AbortF), AbortEE AbortableF x
AbortF)                      -> x
a
    (x, x)
_                                                         -> x -> x -> x
mergeOther x
a x
b

{-
mergeUnsized :: (Base x ~ f, UnsizedBase f, PrettyPrintable x, Eq x, Corecursive x, Recursive x) => (x -> x -> x) -> (x -> x -> x) -> x -> x -> x
mergeUnsized mergeDown mergeOther a b = case (a,b) of
  (UnsizedEE aa, UnsizedEE bb) -> case (aa,bb) of
    (RecursionTestF ta x, RecursionTestF tb y) | ta == tb -> unsizedEE . RecursionTestF ta $ mergeDown x y
    (UnsizedStubF ta x, UnsizedStubF tb y) | ta == tb -> unsizedEE . UnsizedStubF ta $ mergeDown x y
    (SizingWrapperF ta x, SizingWrapperF tb y) | ta == tb -> unsizedEE . SizingWrapperF ta $ mergeDown x y
    (SizeStageF ta na x, SizeStageF tb nb y) | ta == tb -> unsizedEE . SizeStageF ta (max na nb) $ mergeDown x y
    _ -> mergeOther a b
  _ -> mergeOther a b
-}

mergeUnknown :: (Base x ~ f, SuperBase f, Eq x, Corecursive x, Recursive x) => x -> x -> x
{-
mergeUnknown a b = if a == b
  then a
  else superEE $ EitherPF a b
-}
mergeUnknown :: forall x (f :: * -> *).
(Base x ~ f, SuperBase f, Eq x, Corecursive x, Recursive x) =>
x -> x -> x
mergeUnknown x
a x
b = forall g (f :: * -> *).
(Base g ~ f, SuperBase f, Corecursive g) =>
SuperPositionF g -> g
superEE forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> SuperPositionF f
EitherPF x
a x
b

data UnsizedRecursionF f
  = RecursionTestF UnsizedRecursionToken f
  | UnsizedStubF UnsizedRecursionToken f
  | SizingWrapperF UnsizedRecursionToken f
  | SizeStageF UnsizedRecursionToken Int f
  deriving (UnsizedRecursionF f -> UnsizedRecursionF f -> Bool
forall f.
Eq f =>
UnsizedRecursionF f -> UnsizedRecursionF f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnsizedRecursionF f -> UnsizedRecursionF f -> Bool
$c/= :: forall f.
Eq f =>
UnsizedRecursionF f -> UnsizedRecursionF f -> Bool
== :: UnsizedRecursionF f -> UnsizedRecursionF f -> Bool
$c== :: forall f.
Eq f =>
UnsizedRecursionF f -> UnsizedRecursionF f -> Bool
Eq, UnsizedRecursionF f -> UnsizedRecursionF f -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {f}. Ord f => Eq (UnsizedRecursionF f)
forall f.
Ord f =>
UnsizedRecursionF f -> UnsizedRecursionF f -> Bool
forall f.
Ord f =>
UnsizedRecursionF f -> UnsizedRecursionF f -> Ordering
forall f.
Ord f =>
UnsizedRecursionF f -> UnsizedRecursionF f -> UnsizedRecursionF f
min :: UnsizedRecursionF f -> UnsizedRecursionF f -> UnsizedRecursionF f
$cmin :: forall f.
Ord f =>
UnsizedRecursionF f -> UnsizedRecursionF f -> UnsizedRecursionF f
max :: UnsizedRecursionF f -> UnsizedRecursionF f -> UnsizedRecursionF f
$cmax :: forall f.
Ord f =>
UnsizedRecursionF f -> UnsizedRecursionF f -> UnsizedRecursionF f
>= :: UnsizedRecursionF f -> UnsizedRecursionF f -> Bool
$c>= :: forall f.
Ord f =>
UnsizedRecursionF f -> UnsizedRecursionF f -> Bool
> :: UnsizedRecursionF f -> UnsizedRecursionF f -> Bool
$c> :: forall f.
Ord f =>
UnsizedRecursionF f -> UnsizedRecursionF f -> Bool
<= :: UnsizedRecursionF f -> UnsizedRecursionF f -> Bool
$c<= :: forall f.
Ord f =>
UnsizedRecursionF f -> UnsizedRecursionF f -> Bool
< :: UnsizedRecursionF f -> UnsizedRecursionF f -> Bool
$c< :: forall f.
Ord f =>
UnsizedRecursionF f -> UnsizedRecursionF f -> Bool
compare :: UnsizedRecursionF f -> UnsizedRecursionF f -> Ordering
$ccompare :: forall f.
Ord f =>
UnsizedRecursionF f -> UnsizedRecursionF f -> Ordering
Ord, Int -> UnsizedRecursionF f -> ShowS
forall f. Show f => Int -> UnsizedRecursionF f -> ShowS
forall f. Show f => [UnsizedRecursionF f] -> ShowS
forall f. Show f => UnsizedRecursionF f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnsizedRecursionF f] -> ShowS
$cshowList :: forall f. Show f => [UnsizedRecursionF f] -> ShowS
show :: UnsizedRecursionF f -> String
$cshow :: forall f. Show f => UnsizedRecursionF f -> String
showsPrec :: Int -> UnsizedRecursionF f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> UnsizedRecursionF f -> ShowS
Show, forall a b. a -> UnsizedRecursionF b -> UnsizedRecursionF a
forall a b. (a -> b) -> UnsizedRecursionF a -> UnsizedRecursionF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> UnsizedRecursionF b -> UnsizedRecursionF a
$c<$ :: forall a b. a -> UnsizedRecursionF b -> UnsizedRecursionF a
fmap :: forall a b. (a -> b) -> UnsizedRecursionF a -> UnsizedRecursionF b
$cfmap :: forall a b. (a -> b) -> UnsizedRecursionF a -> UnsizedRecursionF b
Functor, forall a. Eq a => a -> UnsizedRecursionF a -> Bool
forall a. Num a => UnsizedRecursionF a -> a
forall a. Ord a => UnsizedRecursionF a -> a
forall m. Monoid m => UnsizedRecursionF m -> m
forall a. UnsizedRecursionF a -> Bool
forall a. UnsizedRecursionF a -> Int
forall a. UnsizedRecursionF a -> [a]
forall a. (a -> a -> a) -> UnsizedRecursionF a -> a
forall m a. Monoid m => (a -> m) -> UnsizedRecursionF a -> m
forall b a. (b -> a -> b) -> b -> UnsizedRecursionF a -> b
forall a b. (a -> b -> b) -> b -> UnsizedRecursionF a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => UnsizedRecursionF a -> a
$cproduct :: forall a. Num a => UnsizedRecursionF a -> a
sum :: forall a. Num a => UnsizedRecursionF a -> a
$csum :: forall a. Num a => UnsizedRecursionF a -> a
minimum :: forall a. Ord a => UnsizedRecursionF a -> a
$cminimum :: forall a. Ord a => UnsizedRecursionF a -> a
maximum :: forall a. Ord a => UnsizedRecursionF a -> a
$cmaximum :: forall a. Ord a => UnsizedRecursionF a -> a
elem :: forall a. Eq a => a -> UnsizedRecursionF a -> Bool
$celem :: forall a. Eq a => a -> UnsizedRecursionF a -> Bool
length :: forall a. UnsizedRecursionF a -> Int
$clength :: forall a. UnsizedRecursionF a -> Int
null :: forall a. UnsizedRecursionF a -> Bool
$cnull :: forall a. UnsizedRecursionF a -> Bool
toList :: forall a. UnsizedRecursionF a -> [a]
$ctoList :: forall a. UnsizedRecursionF a -> [a]
foldl1 :: forall a. (a -> a -> a) -> UnsizedRecursionF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> UnsizedRecursionF a -> a
foldr1 :: forall a. (a -> a -> a) -> UnsizedRecursionF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> UnsizedRecursionF a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> UnsizedRecursionF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> UnsizedRecursionF a -> b
foldl :: forall b a. (b -> a -> b) -> b -> UnsizedRecursionF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> UnsizedRecursionF a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> UnsizedRecursionF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> UnsizedRecursionF a -> b
foldr :: forall a b. (a -> b -> b) -> b -> UnsizedRecursionF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> UnsizedRecursionF a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> UnsizedRecursionF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> UnsizedRecursionF a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> UnsizedRecursionF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> UnsizedRecursionF a -> m
fold :: forall m. Monoid m => UnsizedRecursionF m -> m
$cfold :: forall m. Monoid m => UnsizedRecursionF m -> m
Foldable, Functor UnsizedRecursionF
Foldable UnsizedRecursionF
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
UnsizedRecursionF (m a) -> m (UnsizedRecursionF a)
forall (f :: * -> *) a.
Applicative f =>
UnsizedRecursionF (f a) -> f (UnsizedRecursionF a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnsizedRecursionF a -> m (UnsizedRecursionF b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnsizedRecursionF a -> f (UnsizedRecursionF b)
sequence :: forall (m :: * -> *) a.
Monad m =>
UnsizedRecursionF (m a) -> m (UnsizedRecursionF a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
UnsizedRecursionF (m a) -> m (UnsizedRecursionF a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnsizedRecursionF a -> m (UnsizedRecursionF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnsizedRecursionF a -> m (UnsizedRecursionF b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
UnsizedRecursionF (f a) -> f (UnsizedRecursionF a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
UnsizedRecursionF (f a) -> f (UnsizedRecursionF a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnsizedRecursionF a -> f (UnsizedRecursionF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnsizedRecursionF a -> f (UnsizedRecursionF b)
Traversable)

instance Eq1 UnsizedRecursionF where
  liftEq :: forall a b.
(a -> b -> Bool)
-> UnsizedRecursionF a -> UnsizedRecursionF b -> Bool
liftEq a -> b -> Bool
test UnsizedRecursionF a
a UnsizedRecursionF b
b = case (UnsizedRecursionF a
a, UnsizedRecursionF b
b) of
    (RecursionTestF UnsizedRecursionToken
ta a
a, RecursionTestF UnsizedRecursionToken
tb b
b) -> UnsizedRecursionToken
ta forall a. Eq a => a -> a -> Bool
== UnsizedRecursionToken
tb Bool -> Bool -> Bool
&& a -> b -> Bool
test a
a b
b
    (UnsizedRecursionF a, UnsizedRecursionF b)
_                                          -> Bool
False

instance Show1 UnsizedRecursionF where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> UnsizedRecursionF a -> ShowS
liftShowsPrec Int -> a -> ShowS
showsPrec [a] -> ShowS
showList Int
prec UnsizedRecursionF a
x = case UnsizedRecursionF a
x of
    RecursionTestF UnsizedRecursionToken
be a
x -> forall a. Show a => a -> ShowS
shows String
"RecursionTestF (" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows UnsizedRecursionToken
be forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showsPrec Int
0 a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
")"
    SizeStageF UnsizedRecursionToken
urt Int
n a
x -> forall a. Show a => a -> ShowS
shows String
"SizeStageF " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows UnsizedRecursionToken
urt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
"_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
n
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
" (" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
showsPrec Int
0 a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
")"

instance PrettyPrintable1 PartExprF where
  showP1 :: forall a. PrettyPrintable a => PartExprF a -> State Int String
showP1 = \case
    PartExprF a
ZeroSF     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"Z"
    PairSF a
a a
b -> String -> State Int String -> State Int String -> State Int String
indentWithTwoChildren' String
"P" (forall p. PrettyPrintable p => p -> State Int String
showP a
a) (forall p. PrettyPrintable p => p -> State Int String
showP a
b)
    PartExprF a
EnvSF      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"E"
    SetEnvSF a
x -> String -> State Int String -> State Int String
indentWithOneChild' String
"S" forall a b. (a -> b) -> a -> b
$ forall p. PrettyPrintable p => p -> State Int String
showP a
x
    GateSF a
l a
r -> String -> State Int String -> State Int String -> State Int String
indentWithTwoChildren' String
"G" (forall p. PrettyPrintable p => p -> State Int String
showP a
l) (forall p. PrettyPrintable p => p -> State Int String
showP a
r)
    LeftSF a
x   -> String -> State Int String -> State Int String
indentWithOneChild' String
"L" forall a b. (a -> b) -> a -> b
$ forall p. PrettyPrintable p => p -> State Int String
showP a
x
    RightSF a
x  -> String -> State Int String -> State Int String
indentWithOneChild' String
"R" forall a b. (a -> b) -> a -> b
$ forall p. PrettyPrintable p => p -> State Int String
showP a
x

instance PrettyPrintable1 SuperPositionF where
  showP1 :: forall a. PrettyPrintable a => SuperPositionF a -> State Int String
showP1 = \case
    SuperPositionF a
AnyPF        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"A"
    EitherPF a
a a
b -> String -> State Int String -> State Int String -> State Int String
indentWithTwoChildren' String
"%" (forall p. PrettyPrintable p => p -> State Int String
showP a
a) (forall p. PrettyPrintable p => p -> State Int String
showP a
b)

instance PrettyPrintable1 AbortableF where
  showP1 :: forall a. PrettyPrintable a => AbortableF a -> State Int String
showP1 = \case
    AbortableF a
AbortF      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"!"
    AbortedF IExpr
am -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String
"(aborted) " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show IExpr
am

instance PrettyPrintable1 UnsizedRecursionF where
  showP1 :: forall a.
PrettyPrintable a =>
UnsizedRecursionF a -> State Int String
showP1 = \case
    RecursionTestF (UnsizedRecursionToken Int
ind) a
x -> String -> State Int String -> State Int String
indentWithOneChild' (String
"T(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
ind forall a. Semigroup a => a -> a -> a
<> String
")") forall a b. (a -> b) -> a -> b
$ forall p. PrettyPrintable p => p -> State Int String
showP a
x
    SizingWrapperF (UnsizedRecursionToken Int
ind) a
x -> String -> State Int String -> State Int String
indentWithOneChild' (String
"&(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
ind forall a. Semigroup a => a -> a -> a
<> String
")") forall a b. (a -> b) -> a -> b
$ forall p. PrettyPrintable p => p -> State Int String
showP a
x
    UnsizedStubF (UnsizedRecursionToken Int
ind) a
x -> String -> State Int String -> State Int String
indentWithOneChild' (String
"#" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
ind) forall a b. (a -> b) -> a -> b
$ forall p. PrettyPrintable p => p -> State Int String
showP a
x
    SizeStageF (UnsizedRecursionToken Int
ind) Int
n a
x -> String -> State Int String -> State Int String
indentWithOneChild' (String
"^" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
ind forall a. Semigroup a => a -> a -> a
<> String
"|" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n) forall a b. (a -> b) -> a -> b
$ forall p. PrettyPrintable p => p -> State Int String
showP a
x

instance PrettyPrintable1 VoidF where
  showP1 :: forall a. PrettyPrintable a => VoidF a -> State Int String
showP1 VoidF a
_ = forall a. HasCallStack => String -> a
error String
"VoidF should never be inhabited, so should not be PrettyPrintable1"

{-
instance PrettyPrintable1 BitsExprF where
  showP1 = \case
    ZeroB -> pure "Z"
    PairB a b -> indentWithTwoChildren' "P" (showP a) (showP b)
    FunctionB vi x -> indentWithOneChild' ("F" <> show (fromEnum vi)) (showP x)
    SetEnvB x -> indentWithOneChild' "S" $ showP x
    GateB l r -> indentWithTwoChildren' "G" (showP l) (showP r)
    VarB vi -> pure $ "V" <> (show $ fromEnum vi)
    AbortB -> pure "A"
    UnsizedChurchNumeralB -> pure "?"

instance PrettyPrintable BitsExpr where
  showP = showP . project

instance PrettyPrintable BitsExprWMap where
  showP (BitsExprWMap expr m) = pure x where
    x = prettyPrint expr <> vs
    showV = show . fromEnum
    vs = cata getF expr where
      getF = \case
        FunctionB v ix -> (("\n" <>) . flip State.evalState 0 . indentWithOneChild' (showV v <> " -") $ lf (embed $ VarB v)) <> ix where
          lf x = case project x of
            VarB vi -> case Map.lookup vi m of
              Nothing -> pure $ "V" <> showV vi
              Just (Fix (PairB a b)) -> indentWithTwoChildren' "P" (lf a) (lf b)
            x' -> showP x'
        x -> Data.Foldable.fold x
-}

data StuckExprF f
  = StuckExprB (PartExprF f)
  | StuckExprS (StuckF f)
  deriving (forall a b. a -> StuckExprF b -> StuckExprF a
forall a b. (a -> b) -> StuckExprF a -> StuckExprF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> StuckExprF b -> StuckExprF a
$c<$ :: forall a b. a -> StuckExprF b -> StuckExprF a
fmap :: forall a b. (a -> b) -> StuckExprF a -> StuckExprF b
$cfmap :: forall a b. (a -> b) -> StuckExprF a -> StuckExprF b
Functor, forall a. Eq a => a -> StuckExprF a -> Bool
forall a. Num a => StuckExprF a -> a
forall a. Ord a => StuckExprF a -> a
forall m. Monoid m => StuckExprF m -> m
forall a. StuckExprF a -> Bool
forall a. StuckExprF a -> Int
forall a. StuckExprF a -> [a]
forall a. (a -> a -> a) -> StuckExprF a -> a
forall m a. Monoid m => (a -> m) -> StuckExprF a -> m
forall b a. (b -> a -> b) -> b -> StuckExprF a -> b
forall a b. (a -> b -> b) -> b -> StuckExprF a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => StuckExprF a -> a
$cproduct :: forall a. Num a => StuckExprF a -> a
sum :: forall a. Num a => StuckExprF a -> a
$csum :: forall a. Num a => StuckExprF a -> a
minimum :: forall a. Ord a => StuckExprF a -> a
$cminimum :: forall a. Ord a => StuckExprF a -> a
maximum :: forall a. Ord a => StuckExprF a -> a
$cmaximum :: forall a. Ord a => StuckExprF a -> a
elem :: forall a. Eq a => a -> StuckExprF a -> Bool
$celem :: forall a. Eq a => a -> StuckExprF a -> Bool
length :: forall a. StuckExprF a -> Int
$clength :: forall a. StuckExprF a -> Int
null :: forall a. StuckExprF a -> Bool
$cnull :: forall a. StuckExprF a -> Bool
toList :: forall a. StuckExprF a -> [a]
$ctoList :: forall a. StuckExprF a -> [a]
foldl1 :: forall a. (a -> a -> a) -> StuckExprF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> StuckExprF a -> a
foldr1 :: forall a. (a -> a -> a) -> StuckExprF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> StuckExprF a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> StuckExprF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> StuckExprF a -> b
foldl :: forall b a. (b -> a -> b) -> b -> StuckExprF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> StuckExprF a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> StuckExprF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> StuckExprF a -> b
foldr :: forall a b. (a -> b -> b) -> b -> StuckExprF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> StuckExprF a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> StuckExprF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> StuckExprF a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> StuckExprF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> StuckExprF a -> m
fold :: forall m. Monoid m => StuckExprF m -> m
$cfold :: forall m. Monoid m => StuckExprF m -> m
Foldable, Functor StuckExprF
Foldable StuckExprF
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
StuckExprF (m a) -> m (StuckExprF a)
forall (f :: * -> *) a.
Applicative f =>
StuckExprF (f a) -> f (StuckExprF a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StuckExprF a -> m (StuckExprF b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StuckExprF a -> f (StuckExprF b)
sequence :: forall (m :: * -> *) a.
Monad m =>
StuckExprF (m a) -> m (StuckExprF a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
StuckExprF (m a) -> m (StuckExprF a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StuckExprF a -> m (StuckExprF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> StuckExprF a -> m (StuckExprF b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
StuckExprF (f a) -> f (StuckExprF a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
StuckExprF (f a) -> f (StuckExprF a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StuckExprF a -> f (StuckExprF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StuckExprF a -> f (StuckExprF b)
Traversable)
instance BasicBase StuckExprF where
  embedB :: forall x. PartExprF x -> StuckExprF x
embedB = forall x. PartExprF x -> StuckExprF x
StuckExprB
  extractB :: forall x. StuckExprF x -> Maybe (PartExprF x)
extractB = \case
    StuckExprB PartExprF x
x -> forall a. a -> Maybe a
Just PartExprF x
x
    StuckExprF x
_            -> forall a. Maybe a
Nothing
instance StuckBase StuckExprF where
  embedS :: forall x. StuckF x -> StuckExprF x
embedS = forall x. StuckF x -> StuckExprF x
StuckExprS
  extractS :: forall x. StuckExprF x -> Maybe (StuckF x)
extractS = \case
    StuckExprS StuckF x
x -> forall a. a -> Maybe a
Just StuckF x
x
    StuckExprF x
_            -> forall a. Maybe a
Nothing
instance PrettyPrintable1 StuckExprF where
  showP1 :: forall a. PrettyPrintable a => StuckExprF a -> State Int String
showP1 = \case
    StuckExprB PartExprF a
x -> forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 PartExprF a
x
    StuckExprS StuckF a
x -> forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 StuckF a
x

type StuckExpr = Fix StuckExprF
instance PrettyPrintable StuckExpr where
  showP :: StuckExpr -> State Int String
showP = forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Recursive t => t -> Base t t
project

data UnsizedExprF f
  = UnsizedExprB (PartExprF f)
  | UnsizedExprS (StuckF f)
  | UnsizedExprP (SuperPositionF f)
  | UnsizedExprA (AbortableF f)
  | UnsizedExprU (UnsizedRecursionF f)
  deriving (forall a b. a -> UnsizedExprF b -> UnsizedExprF a
forall a b. (a -> b) -> UnsizedExprF a -> UnsizedExprF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> UnsizedExprF b -> UnsizedExprF a
$c<$ :: forall a b. a -> UnsizedExprF b -> UnsizedExprF a
fmap :: forall a b. (a -> b) -> UnsizedExprF a -> UnsizedExprF b
$cfmap :: forall a b. (a -> b) -> UnsizedExprF a -> UnsizedExprF b
Functor, forall a. Eq a => a -> UnsizedExprF a -> Bool
forall a. Num a => UnsizedExprF a -> a
forall a. Ord a => UnsizedExprF a -> a
forall m. Monoid m => UnsizedExprF m -> m
forall a. UnsizedExprF a -> Bool
forall a. UnsizedExprF a -> Int
forall a. UnsizedExprF a -> [a]
forall a. (a -> a -> a) -> UnsizedExprF a -> a
forall m a. Monoid m => (a -> m) -> UnsizedExprF a -> m
forall b a. (b -> a -> b) -> b -> UnsizedExprF a -> b
forall a b. (a -> b -> b) -> b -> UnsizedExprF a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => UnsizedExprF a -> a
$cproduct :: forall a. Num a => UnsizedExprF a -> a
sum :: forall a. Num a => UnsizedExprF a -> a
$csum :: forall a. Num a => UnsizedExprF a -> a
minimum :: forall a. Ord a => UnsizedExprF a -> a
$cminimum :: forall a. Ord a => UnsizedExprF a -> a
maximum :: forall a. Ord a => UnsizedExprF a -> a
$cmaximum :: forall a. Ord a => UnsizedExprF a -> a
elem :: forall a. Eq a => a -> UnsizedExprF a -> Bool
$celem :: forall a. Eq a => a -> UnsizedExprF a -> Bool
length :: forall a. UnsizedExprF a -> Int
$clength :: forall a. UnsizedExprF a -> Int
null :: forall a. UnsizedExprF a -> Bool
$cnull :: forall a. UnsizedExprF a -> Bool
toList :: forall a. UnsizedExprF a -> [a]
$ctoList :: forall a. UnsizedExprF a -> [a]
foldl1 :: forall a. (a -> a -> a) -> UnsizedExprF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> UnsizedExprF a -> a
foldr1 :: forall a. (a -> a -> a) -> UnsizedExprF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> UnsizedExprF a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> UnsizedExprF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> UnsizedExprF a -> b
foldl :: forall b a. (b -> a -> b) -> b -> UnsizedExprF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> UnsizedExprF a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> UnsizedExprF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> UnsizedExprF a -> b
foldr :: forall a b. (a -> b -> b) -> b -> UnsizedExprF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> UnsizedExprF a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> UnsizedExprF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> UnsizedExprF a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> UnsizedExprF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> UnsizedExprF a -> m
fold :: forall m. Monoid m => UnsizedExprF m -> m
$cfold :: forall m. Monoid m => UnsizedExprF m -> m
Foldable, Functor UnsizedExprF
Foldable UnsizedExprF
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
UnsizedExprF (m a) -> m (UnsizedExprF a)
forall (f :: * -> *) a.
Applicative f =>
UnsizedExprF (f a) -> f (UnsizedExprF a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnsizedExprF a -> m (UnsizedExprF b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnsizedExprF a -> f (UnsizedExprF b)
sequence :: forall (m :: * -> *) a.
Monad m =>
UnsizedExprF (m a) -> m (UnsizedExprF a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
UnsizedExprF (m a) -> m (UnsizedExprF a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnsizedExprF a -> m (UnsizedExprF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnsizedExprF a -> m (UnsizedExprF b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
UnsizedExprF (f a) -> f (UnsizedExprF a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
UnsizedExprF (f a) -> f (UnsizedExprF a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnsizedExprF a -> f (UnsizedExprF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnsizedExprF a -> f (UnsizedExprF b)
Traversable)
instance BasicBase UnsizedExprF where
  embedB :: forall x. PartExprF x -> UnsizedExprF x
embedB = forall x. PartExprF x -> UnsizedExprF x
UnsizedExprB
  extractB :: forall x. UnsizedExprF x -> Maybe (PartExprF x)
extractB = \case
    UnsizedExprB PartExprF x
x -> forall a. a -> Maybe a
Just PartExprF x
x
    UnsizedExprF x
_              -> forall a. Maybe a
Nothing
instance StuckBase UnsizedExprF where
  embedS :: forall x. StuckF x -> UnsizedExprF x
embedS = forall x. StuckF x -> UnsizedExprF x
UnsizedExprS
  extractS :: forall x. UnsizedExprF x -> Maybe (StuckF x)
extractS = \case
    UnsizedExprS StuckF x
x -> forall a. a -> Maybe a
Just StuckF x
x
    UnsizedExprF x
_              -> forall a. Maybe a
Nothing
instance SuperBase UnsizedExprF where
  embedP :: forall x. SuperPositionF x -> UnsizedExprF x
embedP = forall x. SuperPositionF x -> UnsizedExprF x
UnsizedExprP
  extractP :: forall x. UnsizedExprF x -> Maybe (SuperPositionF x)
extractP = \case
    UnsizedExprP SuperPositionF x
x -> forall a. a -> Maybe a
Just SuperPositionF x
x
    UnsizedExprF x
_              -> forall a. Maybe a
Nothing
instance AbortBase UnsizedExprF where
  embedA :: forall x. AbortableF x -> UnsizedExprF x
embedA = forall x. AbortableF x -> UnsizedExprF x
UnsizedExprA
  extractA :: forall x. UnsizedExprF x -> Maybe (AbortableF x)
extractA = \case
    UnsizedExprA AbortableF x
x -> forall a. a -> Maybe a
Just AbortableF x
x
    UnsizedExprF x
_              -> forall a. Maybe a
Nothing
instance UnsizedBase UnsizedExprF where
  embedU :: forall x. UnsizedRecursionF x -> UnsizedExprF x
embedU = forall x. UnsizedRecursionF x -> UnsizedExprF x
UnsizedExprU
  extractU :: forall x. UnsizedExprF x -> Maybe (UnsizedRecursionF x)
extractU = \case
    UnsizedExprU UnsizedRecursionF x
x -> forall a. a -> Maybe a
Just UnsizedRecursionF x
x
    UnsizedExprF x
_              -> forall a. Maybe a
Nothing
instance Eq1 UnsizedExprF where
  liftEq :: forall a b.
(a -> b -> Bool) -> UnsizedExprF a -> UnsizedExprF b -> Bool
liftEq a -> b -> Bool
test UnsizedExprF a
a UnsizedExprF b
b = case (UnsizedExprF a
a,UnsizedExprF b
b) of
    (UnsizedExprB PartExprF a
x, UnsizedExprB PartExprF b
y) -> forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
test PartExprF a
x PartExprF b
y
    (UnsizedExprS StuckF a
x, UnsizedExprS StuckF b
y) -> forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
test StuckF a
x StuckF b
y
    (UnsizedExprP SuperPositionF a
x, UnsizedExprP SuperPositionF b
y) -> forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
test SuperPositionF a
x SuperPositionF b
y
    (UnsizedExprA AbortableF a
x, UnsizedExprA AbortableF b
y) -> forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
test AbortableF a
x AbortableF b
y
    (UnsizedExprU UnsizedRecursionF a
x, UnsizedExprU UnsizedRecursionF b
y) -> forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
test UnsizedRecursionF a
x UnsizedRecursionF b
y
    (UnsizedExprF a, UnsizedExprF b)
_                                -> Bool
False
instance PrettyPrintable1 UnsizedExprF where
  showP1 :: forall a. PrettyPrintable a => UnsizedExprF a -> State Int String
showP1 = \case
    UnsizedExprB PartExprF a
x -> forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 PartExprF a
x
    UnsizedExprS StuckF a
x -> forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 StuckF a
x
    UnsizedExprP SuperPositionF a
x -> forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 SuperPositionF a
x
    UnsizedExprA AbortableF a
x -> forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 AbortableF a
x
    UnsizedExprU UnsizedRecursionF a
x -> forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 UnsizedRecursionF a
x

type UnsizedExpr = Fix UnsizedExprF
instance PrettyPrintable UnsizedExpr where
  showP :: UnsizedExpr -> State Int String
showP = forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Recursive t => t -> Base t t
project

data SuperExprF f
  = SuperExprB (PartExprF f)
  | SuperExprS (StuckF f)
  | SuperExprA (AbortableF f)
  | SuperExprP (SuperPositionF f)
  deriving (forall a b. a -> SuperExprF b -> SuperExprF a
forall a b. (a -> b) -> SuperExprF a -> SuperExprF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SuperExprF b -> SuperExprF a
$c<$ :: forall a b. a -> SuperExprF b -> SuperExprF a
fmap :: forall a b. (a -> b) -> SuperExprF a -> SuperExprF b
$cfmap :: forall a b. (a -> b) -> SuperExprF a -> SuperExprF b
Functor, forall a. Eq a => a -> SuperExprF a -> Bool
forall a. Num a => SuperExprF a -> a
forall a. Ord a => SuperExprF a -> a
forall m. Monoid m => SuperExprF m -> m
forall a. SuperExprF a -> Bool
forall a. SuperExprF a -> Int
forall a. SuperExprF a -> [a]
forall a. (a -> a -> a) -> SuperExprF a -> a
forall m a. Monoid m => (a -> m) -> SuperExprF a -> m
forall b a. (b -> a -> b) -> b -> SuperExprF a -> b
forall a b. (a -> b -> b) -> b -> SuperExprF a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => SuperExprF a -> a
$cproduct :: forall a. Num a => SuperExprF a -> a
sum :: forall a. Num a => SuperExprF a -> a
$csum :: forall a. Num a => SuperExprF a -> a
minimum :: forall a. Ord a => SuperExprF a -> a
$cminimum :: forall a. Ord a => SuperExprF a -> a
maximum :: forall a. Ord a => SuperExprF a -> a
$cmaximum :: forall a. Ord a => SuperExprF a -> a
elem :: forall a. Eq a => a -> SuperExprF a -> Bool
$celem :: forall a. Eq a => a -> SuperExprF a -> Bool
length :: forall a. SuperExprF a -> Int
$clength :: forall a. SuperExprF a -> Int
null :: forall a. SuperExprF a -> Bool
$cnull :: forall a. SuperExprF a -> Bool
toList :: forall a. SuperExprF a -> [a]
$ctoList :: forall a. SuperExprF a -> [a]
foldl1 :: forall a. (a -> a -> a) -> SuperExprF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SuperExprF a -> a
foldr1 :: forall a. (a -> a -> a) -> SuperExprF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> SuperExprF a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> SuperExprF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SuperExprF a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SuperExprF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SuperExprF a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SuperExprF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SuperExprF a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SuperExprF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> SuperExprF a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> SuperExprF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SuperExprF a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SuperExprF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SuperExprF a -> m
fold :: forall m. Monoid m => SuperExprF m -> m
$cfold :: forall m. Monoid m => SuperExprF m -> m
Foldable, Functor SuperExprF
Foldable SuperExprF
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SuperExprF (m a) -> m (SuperExprF a)
forall (f :: * -> *) a.
Applicative f =>
SuperExprF (f a) -> f (SuperExprF a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SuperExprF a -> m (SuperExprF b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SuperExprF a -> f (SuperExprF b)
sequence :: forall (m :: * -> *) a.
Monad m =>
SuperExprF (m a) -> m (SuperExprF a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SuperExprF (m a) -> m (SuperExprF a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SuperExprF a -> m (SuperExprF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SuperExprF a -> m (SuperExprF b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SuperExprF (f a) -> f (SuperExprF a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SuperExprF (f a) -> f (SuperExprF a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SuperExprF a -> f (SuperExprF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SuperExprF a -> f (SuperExprF b)
Traversable)
instance BasicBase SuperExprF where
  embedB :: forall x. PartExprF x -> SuperExprF x
embedB = forall x. PartExprF x -> SuperExprF x
SuperExprB
  extractB :: forall x. SuperExprF x -> Maybe (PartExprF x)
extractB = \case
    SuperExprB PartExprF x
x -> forall a. a -> Maybe a
Just PartExprF x
x
    SuperExprF x
_            -> forall a. Maybe a
Nothing
instance StuckBase SuperExprF where
  embedS :: forall x. StuckF x -> SuperExprF x
embedS = forall x. StuckF x -> SuperExprF x
SuperExprS
  extractS :: forall x. SuperExprF x -> Maybe (StuckF x)
extractS = \case
    SuperExprS StuckF x
x -> forall a. a -> Maybe a
Just StuckF x
x
    SuperExprF x
_            -> forall a. Maybe a
Nothing
instance AbortBase SuperExprF where
  embedA :: forall x. AbortableF x -> SuperExprF x
embedA = forall x. AbortableF x -> SuperExprF x
SuperExprA
  extractA :: forall x. SuperExprF x -> Maybe (AbortableF x)
extractA = \case
    SuperExprA AbortableF x
x -> forall a. a -> Maybe a
Just AbortableF x
x
    SuperExprF x
_            -> forall a. Maybe a
Nothing
instance SuperBase SuperExprF where
  embedP :: forall x. SuperPositionF x -> SuperExprF x
embedP = forall x. SuperPositionF x -> SuperExprF x
SuperExprP
  extractP :: forall x. SuperExprF x -> Maybe (SuperPositionF x)
extractP = \case
    SuperExprP SuperPositionF x
x -> forall a. a -> Maybe a
Just SuperPositionF x
x
    SuperExprF x
_            -> forall a. Maybe a
Nothing
instance Eq1 SuperExprF where
  liftEq :: forall a b.
(a -> b -> Bool) -> SuperExprF a -> SuperExprF b -> Bool
liftEq a -> b -> Bool
test SuperExprF a
a SuperExprF b
b = case (SuperExprF a
a,SuperExprF b
b) of
    (SuperExprB PartExprF a
x, SuperExprB PartExprF b
y) -> forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
test PartExprF a
x PartExprF b
y
    (SuperExprS StuckF a
x, SuperExprS StuckF b
y) -> forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
test StuckF a
x StuckF b
y
    (SuperExprA AbortableF a
x, SuperExprA AbortableF b
y) -> forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
test AbortableF a
x AbortableF b
y
    (SuperExprP SuperPositionF a
x, SuperExprP SuperPositionF b
y) -> forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
test SuperPositionF a
x SuperPositionF b
y
    (SuperExprF a, SuperExprF b)
_                            -> Bool
False
instance PrettyPrintable1 SuperExprF where
  showP1 :: forall a. PrettyPrintable a => SuperExprF a -> State Int String
showP1 = \case
    SuperExprB PartExprF a
x -> forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 PartExprF a
x
    SuperExprS StuckF a
x -> forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 StuckF a
x
    SuperExprA AbortableF a
x -> forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 AbortableF a
x
    SuperExprP SuperPositionF a
x -> forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 SuperPositionF a
x

type SuperExpr = Fix SuperExprF
instance PrettyPrintable SuperExpr where
  showP :: SuperExpr -> State Int String
showP = forall p. PrettyPrintable p => p -> State Int String
showP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Recursive t => t -> Base t t
project

data AbortExprF f
  = AbortExprB (PartExprF f)
  | AbortExprS (StuckF f)
  | AbortExprA (AbortableF f)
  deriving (forall a b. a -> AbortExprF b -> AbortExprF a
forall a b. (a -> b) -> AbortExprF a -> AbortExprF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AbortExprF b -> AbortExprF a
$c<$ :: forall a b. a -> AbortExprF b -> AbortExprF a
fmap :: forall a b. (a -> b) -> AbortExprF a -> AbortExprF b
$cfmap :: forall a b. (a -> b) -> AbortExprF a -> AbortExprF b
Functor, forall a. Eq a => a -> AbortExprF a -> Bool
forall a. Num a => AbortExprF a -> a
forall a. Ord a => AbortExprF a -> a
forall m. Monoid m => AbortExprF m -> m
forall a. AbortExprF a -> Bool
forall a. AbortExprF a -> Int
forall a. AbortExprF a -> [a]
forall a. (a -> a -> a) -> AbortExprF a -> a
forall m a. Monoid m => (a -> m) -> AbortExprF a -> m
forall b a. (b -> a -> b) -> b -> AbortExprF a -> b
forall a b. (a -> b -> b) -> b -> AbortExprF a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => AbortExprF a -> a
$cproduct :: forall a. Num a => AbortExprF a -> a
sum :: forall a. Num a => AbortExprF a -> a
$csum :: forall a. Num a => AbortExprF a -> a
minimum :: forall a. Ord a => AbortExprF a -> a
$cminimum :: forall a. Ord a => AbortExprF a -> a
maximum :: forall a. Ord a => AbortExprF a -> a
$cmaximum :: forall a. Ord a => AbortExprF a -> a
elem :: forall a. Eq a => a -> AbortExprF a -> Bool
$celem :: forall a. Eq a => a -> AbortExprF a -> Bool
length :: forall a. AbortExprF a -> Int
$clength :: forall a. AbortExprF a -> Int
null :: forall a. AbortExprF a -> Bool
$cnull :: forall a. AbortExprF a -> Bool
toList :: forall a. AbortExprF a -> [a]
$ctoList :: forall a. AbortExprF a -> [a]
foldl1 :: forall a. (a -> a -> a) -> AbortExprF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> AbortExprF a -> a
foldr1 :: forall a. (a -> a -> a) -> AbortExprF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> AbortExprF a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> AbortExprF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> AbortExprF a -> b
foldl :: forall b a. (b -> a -> b) -> b -> AbortExprF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> AbortExprF a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> AbortExprF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> AbortExprF a -> b
foldr :: forall a b. (a -> b -> b) -> b -> AbortExprF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> AbortExprF a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> AbortExprF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> AbortExprF a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> AbortExprF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> AbortExprF a -> m
fold :: forall m. Monoid m => AbortExprF m -> m
$cfold :: forall m. Monoid m => AbortExprF m -> m
Foldable, Functor AbortExprF
Foldable AbortExprF
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
AbortExprF (m a) -> m (AbortExprF a)
forall (f :: * -> *) a.
Applicative f =>
AbortExprF (f a) -> f (AbortExprF a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AbortExprF a -> m (AbortExprF b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AbortExprF a -> f (AbortExprF b)
sequence :: forall (m :: * -> *) a.
Monad m =>
AbortExprF (m a) -> m (AbortExprF a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
AbortExprF (m a) -> m (AbortExprF a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AbortExprF a -> m (AbortExprF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AbortExprF a -> m (AbortExprF b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
AbortExprF (f a) -> f (AbortExprF a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
AbortExprF (f a) -> f (AbortExprF a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AbortExprF a -> f (AbortExprF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AbortExprF a -> f (AbortExprF b)
Traversable)
instance BasicBase AbortExprF where
  embedB :: forall x. PartExprF x -> AbortExprF x
embedB = forall x. PartExprF x -> AbortExprF x
AbortExprB
  extractB :: forall x. AbortExprF x -> Maybe (PartExprF x)
extractB = \case
    AbortExprB PartExprF x
x -> forall a. a -> Maybe a
Just PartExprF x
x
    AbortExprF x
_            -> forall a. Maybe a
Nothing
instance StuckBase AbortExprF where
  embedS :: forall x. StuckF x -> AbortExprF x
embedS = forall x. StuckF x -> AbortExprF x
AbortExprS
  extractS :: forall x. AbortExprF x -> Maybe (StuckF x)
extractS = \case
    AbortExprS StuckF x
x -> forall a. a -> Maybe a
Just StuckF x
x
    AbortExprF x
_            -> forall a. Maybe a
Nothing
instance AbortBase AbortExprF where
  embedA :: forall x. AbortableF x -> AbortExprF x
embedA = forall x. AbortableF x -> AbortExprF x
AbortExprA
  extractA :: forall x. AbortExprF x -> Maybe (AbortableF x)
extractA = \case
    AbortExprA AbortableF x
x -> forall a. a -> Maybe a
Just AbortableF x
x
    AbortExprF x
_            -> forall a. Maybe a
Nothing
instance Eq1 AbortExprF where
  liftEq :: forall a b.
(a -> b -> Bool) -> AbortExprF a -> AbortExprF b -> Bool
liftEq a -> b -> Bool
test AbortExprF a
a AbortExprF b
b = case (AbortExprF a
a,AbortExprF b
b) of
    (AbortExprB PartExprF a
x, AbortExprB PartExprF b
y) -> forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
test PartExprF a
x PartExprF b
y
    (AbortExprS StuckF a
x, AbortExprS StuckF b
y) -> forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
test StuckF a
x StuckF b
y
    (AbortExprA AbortableF a
x, AbortExprA AbortableF b
y) -> forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
test AbortableF a
x AbortableF b
y
    (AbortExprF a, AbortExprF b)
_                            -> Bool
False
instance PrettyPrintable1 AbortExprF where
  showP1 :: forall a. PrettyPrintable a => AbortExprF a -> State Int String
showP1 = \case
    AbortExprB PartExprF a
x -> forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 PartExprF a
x
    AbortExprS StuckF a
x -> forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 StuckF a
x
    AbortExprA AbortableF a
x -> forall (p :: * -> *) a.
(PrettyPrintable1 p, PrettyPrintable a) =>
p a -> State Int String
showP1 AbortableF a
x

type AbortExpr = Fix AbortExprF
instance PrettyPrintable AbortExpr where
  showP :: AbortExpr -> State Int String
showP = forall p. PrettyPrintable p => p -> State Int String
showP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Recursive t => t -> Base t t
project

instance PrettyPrintable Char where
  showP :: Char -> State Int String
showP = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])

unsized2abortExpr :: UnsizedExpr -> AbortExpr
unsized2abortExpr :: UnsizedExpr -> AbortExpr
unsized2abortExpr = forall s t.
(Recursive s, Corecursive t) =>
(forall a. Base s a -> Base t a) -> s -> t
hoist forall a. UnsizedExprF a -> AbortExprF a
f where
  f :: UnsizedExprF a -> AbortExprF a
  f :: forall a. UnsizedExprF a -> AbortExprF a
f = \case
    UnsizedExprB PartExprF a
x -> forall x. PartExprF x -> AbortExprF x
AbortExprB PartExprF a
x
    UnsizedExprS StuckF a
x -> forall x. StuckF x -> AbortExprF x
AbortExprS StuckF a
x
    -- UnsizedExprP x -> AbortExprP x
    UnsizedExprA AbortableF a
x -> forall x. AbortableF x -> AbortExprF x
AbortExprA AbortableF a
x
    UnsizedExprF a
x -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"unsized2abortExpr unexpected unsized bit: " forall a. Semigroup a => a -> a -> a
<> forall p. PrettyPrintable p => p -> String
prettyPrint (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const Char
' ') UnsizedExprF a
x)

term3ToUnsizedExpr :: Int -> Term3 -> UnsizedExpr
term3ToUnsizedExpr :: Int -> Term3 -> UnsizedExpr
term3ToUnsizedExpr Int
maxSize (Term3 Map FragIndex FragExprUR
termMap) =
  let fragLookup :: FragIndex -> FragExprUR
fragLookup = (Map FragIndex FragExprUR
termMap forall k a. Ord k => Map k a -> k -> a
Map.!)
      f :: FragExpr (RecursionSimulationPieces FragExprUR) -> UnsizedExpr
f = \case
        FragExpr (RecursionSimulationPieces FragExprUR)
ZeroFrag -> forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall f. PartExprF f
ZeroSF
        PairFrag FragExpr (RecursionSimulationPieces FragExprUR)
a FragExpr (RecursionSimulationPieces FragExprUR)
b -> forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> PartExprF f
PairSF (FragExpr (RecursionSimulationPieces FragExprUR) -> UnsizedExpr
f FragExpr (RecursionSimulationPieces FragExprUR)
a) (FragExpr (RecursionSimulationPieces FragExprUR) -> UnsizedExpr
f FragExpr (RecursionSimulationPieces FragExprUR)
b)
        FragExpr (RecursionSimulationPieces FragExprUR)
EnvFrag -> forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall f. PartExprF f
EnvSF
        SetEnvFrag FragExpr (RecursionSimulationPieces FragExprUR)
x -> forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
SetEnvSF forall a b. (a -> b) -> a -> b
$ FragExpr (RecursionSimulationPieces FragExprUR) -> UnsizedExpr
f FragExpr (RecursionSimulationPieces FragExprUR)
x
        DeferFrag FragIndex
ind -> forall g (f :: * -> *).
(Base g ~ f, StuckBase f, Corecursive g) =>
StuckF g -> g
stuckEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. FunctionIndex -> f -> StuckF f
DeferSF (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum FragIndex
ind) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FragExpr (RecursionSimulationPieces FragExprUR) -> UnsizedExpr
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a anno. Corecursive a => Cofree (Base a) anno -> a
forget forall b c a. (b -> c) -> (a -> b) -> a -> c
. FragExprUR
-> Cofree (FragExprF (RecursionSimulationPieces FragExprUR)) LocTag
unFragExprUR forall a b. (a -> b) -> a -> b
$ FragIndex -> FragExprUR
fragLookup FragIndex
ind
        FragExpr (RecursionSimulationPieces FragExprUR)
AbortFrag -> forall g (f :: * -> *).
(Base g ~ f, AbortBase f, Corecursive g) =>
AbortableF g -> g
abortEE forall f. AbortableF f
AbortF
        GateFrag FragExpr (RecursionSimulationPieces FragExprUR)
l FragExpr (RecursionSimulationPieces FragExprUR)
r -> forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> PartExprF f
GateSF (FragExpr (RecursionSimulationPieces FragExprUR) -> UnsizedExpr
f FragExpr (RecursionSimulationPieces FragExprUR)
l) (FragExpr (RecursionSimulationPieces FragExprUR) -> UnsizedExpr
f FragExpr (RecursionSimulationPieces FragExprUR)
r)
        LeftFrag FragExpr (RecursionSimulationPieces FragExprUR)
x -> forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
LeftSF forall a b. (a -> b) -> a -> b
$ FragExpr (RecursionSimulationPieces FragExprUR) -> UnsizedExpr
f FragExpr (RecursionSimulationPieces FragExprUR)
x
        RightFrag FragExpr (RecursionSimulationPieces FragExprUR)
x -> forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
RightSF forall a b. (a -> b) -> a -> b
$ FragExpr (RecursionSimulationPieces FragExprUR) -> UnsizedExpr
f FragExpr (RecursionSimulationPieces FragExprUR)
x
        FragExpr (RecursionSimulationPieces FragExprUR)
TraceFrag -> forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall f. PartExprF f
EnvSF
        AuxFrag (SizingWrapper UnsizedRecursionToken
tok (FragExprUR Cofree (FragExprF (RecursionSimulationPieces FragExprUR)) LocTag
x)) -> forall g (f :: * -> *).
(Base g ~ f, UnsizedBase f, Corecursive g) =>
UnsizedRecursionF g -> g
unsizedEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. UnsizedRecursionToken -> f -> UnsizedRecursionF f
SizingWrapperF UnsizedRecursionToken
tok forall b c a. (b -> c) -> (a -> b) -> a -> c
. FragExpr (RecursionSimulationPieces FragExprUR) -> UnsizedExpr
f forall a b. (a -> b) -> a -> b
$ forall a anno. Corecursive a => Cofree (Base a) anno -> a
forget Cofree (FragExprF (RecursionSimulationPieces FragExprUR)) LocTag
x
        AuxFrag (NestedSetEnvs UnsizedRecursionToken
t) -> forall g (f :: * -> *).
(Base g ~ f, UnsizedBase f, Corecursive g) =>
UnsizedRecursionF g -> g
unsizedEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. UnsizedRecursionToken -> f -> UnsizedRecursionF f
UnsizedStubF UnsizedRecursionToken
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Corecursive t => Base t t -> t
embed forall a b. (a -> b) -> a -> b
$ forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall f. PartExprF f
EnvSF
  in FragExpr (RecursionSimulationPieces FragExprUR) -> UnsizedExpr
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a anno. Corecursive a => Cofree (Base a) anno -> a
forget forall b c a. (b -> c) -> (a -> b) -> a -> c
. FragExprUR
-> Cofree (FragExprF (RecursionSimulationPieces FragExprUR)) LocTag
unFragExprUR forall a b. (a -> b) -> a -> b
$ forall a. Map FragIndex a -> a
rootFrag Map FragIndex FragExprUR
termMap

data SizedResult = AbortedSR | UnsizableSR UnsizedRecursionToken
  deriving (SizedResult -> SizedResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SizedResult -> SizedResult -> Bool
$c/= :: SizedResult -> SizedResult -> Bool
== :: SizedResult -> SizedResult -> Bool
$c== :: SizedResult -> SizedResult -> Bool
Eq, Eq SizedResult
SizedResult -> SizedResult -> Bool
SizedResult -> SizedResult -> Ordering
SizedResult -> SizedResult -> SizedResult
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SizedResult -> SizedResult -> SizedResult
$cmin :: SizedResult -> SizedResult -> SizedResult
max :: SizedResult -> SizedResult -> SizedResult
$cmax :: SizedResult -> SizedResult -> SizedResult
>= :: SizedResult -> SizedResult -> Bool
$c>= :: SizedResult -> SizedResult -> Bool
> :: SizedResult -> SizedResult -> Bool
$c> :: SizedResult -> SizedResult -> Bool
<= :: SizedResult -> SizedResult -> Bool
$c<= :: SizedResult -> SizedResult -> Bool
< :: SizedResult -> SizedResult -> Bool
$c< :: SizedResult -> SizedResult -> Bool
compare :: SizedResult -> SizedResult -> Ordering
$ccompare :: SizedResult -> SizedResult -> Ordering
Ord, Int -> SizedResult -> ShowS
[SizedResult] -> ShowS
SizedResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SizedResult] -> ShowS
$cshowList :: [SizedResult] -> ShowS
show :: SizedResult -> String
$cshow :: SizedResult -> String
showsPrec :: Int -> SizedResult -> ShowS
$cshowsPrec :: Int -> SizedResult -> ShowS
Show)

instance Semigroup SizedResult where
  <> :: SizedResult -> SizedResult -> SizedResult
(<>) SizedResult
a SizedResult
b = case (SizedResult
a,SizedResult
b) of
    (u :: SizedResult
u@(UnsizableSR UnsizedRecursionToken
_), SizedResult
_) -> SizedResult
u
    (SizedResult
_, u :: SizedResult
u@(UnsizableSR UnsizedRecursionToken
_)) -> SizedResult
u
    (SizedResult, SizedResult)
_                      -> SizedResult
a

newtype MonoidList a = MonoidList { forall a. MonoidList a -> [a]
unMonoidList :: [a] }

instance Semigroup a => Semigroup (MonoidList a) where
  <> :: MonoidList a -> MonoidList a -> MonoidList a
(<>) (MonoidList [a]
a) (MonoidList [a]
b) = forall a. [a] -> MonoidList a
MonoidList forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Semigroup a => a -> a -> a
(<>) [a]
a [a]
b

instance Semigroup a => Monoid (MonoidList a) where
  mempty :: MonoidList a
mempty = forall a. [a] -> MonoidList a
MonoidList []

capMain :: (Base g ~ f, BasicBase f, StuckBase f, SuperBase f, Recursive g, Corecursive g) => g -> g
capMain :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, StuckBase f, SuperBase f, Recursive g,
 Corecursive g) =>
g -> g
capMain = \case  -- make sure main functions are fully applied with Any data
  BasicEE (PairSF d :: g
d@(StuckEE (DeferSF FunctionIndex
_ g
_)) g
_) -> forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
SetEnvSF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> f -> PartExprF f
PairSF g
d forall a b. (a -> b) -> a -> b
$ forall g (f :: * -> *).
(Base g ~ f, SuperBase f, Corecursive g) =>
SuperPositionF g -> g
superEE forall f. SuperPositionF f
AnyPF
  g
x -> g
x

isClosure :: (Base g ~ f, BasicBase f, StuckBase f, SuperBase f, Recursive g, Corecursive g) => g -> Bool
isClosure :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, StuckBase f, SuperBase f, Recursive g,
 Corecursive g) =>
g -> Bool
isClosure = \case
  BasicEE (PairSF (StuckEE (DeferSF FunctionIndex
_ g
_)) g
_) -> Bool
True
  g
_                                          -> Bool
False

sizeTerm :: Int -> UnsizedExpr -> Either UnsizedRecursionToken AbortExpr
sizeTerm :: Int -> UnsizedExpr -> Either UnsizedRecursionToken AbortExpr
sizeTerm Int
maxSize UnsizedExpr
x = StrictAccum SizedRecursion UnsizedExpr
-> Either UnsizedRecursionToken AbortExpr
tidyUp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (f :: * -> *) (m :: * -> *).
(Base g ~ f, StuckBase f, Monad m, Recursive g) =>
(f (m g) -> m g) -> g -> m g
transformNoDeferM UnsizedExprF (StrictAccum SizedRecursion UnsizedExpr)
-> StrictAccum SizedRecursion UnsizedExpr
evalStep forall a b. (a -> b) -> a -> b
$ forall g (f :: * -> *).
(Base g ~ f, BasicBase f, StuckBase f, SuperBase f, Recursive g,
 Corecursive g) =>
g -> g
capMain UnsizedExpr
x where
  tidyUp :: StrictAccum SizedRecursion UnsizedExpr
-> Either UnsizedRecursionToken AbortExpr
tidyUp (StrictAccum (SizedRecursion Map UnsizedRecursionToken Int
sm) UnsizedExpr
r) = case UnsizedExpr -> Maybe SizedResult
foldAborted UnsizedExpr
r of
    Just (UnsizableSR UnsizedRecursionToken
i) -> forall a b. a -> Either a b
Left UnsizedRecursionToken
i
    Maybe SizedResult
_ -> let sized :: UnsizedExpr
sized = Map UnsizedRecursionToken Int -> UnsizedExpr -> UnsizedExpr
setSizes Map UnsizedRecursionToken Int
sm UnsizedExpr
x
         in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsizedExpr -> AbortExpr
clean forall a b. (a -> b) -> a -> b
$ if forall g (f :: * -> *).
(Base g ~ f, BasicBase f, StuckBase f, SuperBase f, Recursive g,
 Corecursive g) =>
g -> Bool
isClosure UnsizedExpr
x
            then UnsizedExpr -> UnsizedExpr
uncap UnsizedExpr
sized
            else UnsizedExpr
sized
      where uncap :: UnsizedExpr -> UnsizedExpr
uncap = \case
              BasicEE (SetEnvSF (BasicEE (PairSF UnsizedExpr
d UnsizedExpr
_))) -> forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> PartExprF f
PairSF UnsizedExpr
d (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall f. PartExprF f
ZeroSF)
              UnsizedExpr
_ -> forall a. HasCallStack => String -> a
error String
"sizeTerm tidyUp trying to uncap something that isn't a main function"
  clean :: UnsizedExpr -> AbortExpr
clean = UnsizedExpr -> AbortExpr
unsized2abortExpr
  setSizes :: Map UnsizedRecursionToken Int -> UnsizedExpr -> UnsizedExpr
  setSizes :: Map UnsizedRecursionToken Int -> UnsizedExpr -> UnsizedExpr
setSizes Map UnsizedRecursionToken Int
sizeMap = forall a. String -> a -> a
debugTrace (String
"setting sizes: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Map UnsizedRecursionToken Int
sizeMap) forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall a b. (a -> b) -> a -> b
$ \case
    UnsizedFW sw :: UnsizedRecursionF UnsizedExpr
sw@(SizingWrapperF UnsizedRecursionToken
tok UnsizedExpr
sx) -> UnsizedExpr
sx
    UnsizedFW us :: UnsizedRecursionF UnsizedExpr
us@(UnsizedStubF UnsizedRecursionToken
tok UnsizedExpr
_) -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UnsizedRecursionToken
tok Map UnsizedRecursionToken Int
sizeMap of
      Just Int
n -> forall a. (a -> a) -> a -> [a]
iterate (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
SetEnvSF) (forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall f. PartExprF f
EnvSF) forall a. [a] -> Int -> a
!! Int
n
      Maybe Int
_      ->  forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
SetEnvSF forall a b. (a -> b) -> a -> b
$ forall g (f :: * -> *).
(Base g ~ f, BasicBase f, Corecursive g) =>
PartExprF g -> g
basicEE forall f. PartExprF f
EnvSF
    UnsizedExprF UnsizedExpr
x -> forall t. Corecursive t => Base t t -> t
embed UnsizedExprF UnsizedExpr
x
  foldAborted :: UnsizedExpr -> Maybe SizedResult
  foldAborted :: UnsizedExpr -> Maybe SizedResult
foldAborted = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata UnsizedExprF (Maybe SizedResult) -> Maybe SizedResult
f where
    f :: UnsizedExprF (Maybe SizedResult) -> Maybe SizedResult
f = \case
      AbortFW (AbortedF IExpr
AbortRecursion) -> forall a. a -> Maybe a
Just SizedResult
AbortedSR
      AbortFW (AbortedF (AbortUnsizeable IExpr
t)) -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsizedRecursionToken -> SizedResult
UnsizableSR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. IExpr -> Int
g2i forall a b. (a -> b) -> a -> b
$ IExpr
t
      UnsizedExprF (Maybe SizedResult)
x                                 -> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Data.Foldable.fold UnsizedExprF (Maybe SizedResult)
x
  unsizedMerge :: UnsizedExpr -> UnsizedExpr -> UnsizedExpr
unsizedMerge = forall x (f :: * -> *).
(Base x ~ f, BasicBase f, Eq x, Corecursive x, Recursive x) =>
(x -> x -> x) -> x -> x -> x
mergeBasic (forall x (f :: * -> *).
(Base x ~ f, StuckBase f, Recursive x) =>
(x -> x -> x) -> x -> x -> x
mergeStuck (forall x (f :: * -> *).
(Base x ~ f, AbortBase f, Eq x, Corecursive x, Recursive x) =>
(x -> x -> x) -> x -> x -> x
mergeAbort (forall x (f :: * -> *).
(Base x ~ f, SuperBase f, Eq x, Corecursive x, Recursive x) =>
(x -> x -> x) -> (x -> x -> x) -> x -> x -> x
mergeSuper UnsizedExpr -> UnsizedExpr -> UnsizedExpr
unsizedMerge forall x (f :: * -> *).
(Base x ~ f, SuperBase f, Eq x, Corecursive x, Recursive x) =>
x -> x -> x
mergeUnknown)))
  evalStep :: UnsizedExprF (StrictAccum SizedRecursion UnsizedExpr)
-> StrictAccum SizedRecursion UnsizedExpr
evalStep = forall g (f :: * -> *) (m :: * -> *).
(Base g ~ f, BasicBase f, Traversable f, Corecursive g,
 Recursive g, PrettyPrintable g, Monad m) =>
(f (m g) -> m g) -> f (m g) -> m g
basicStepM (forall a (f :: * -> *) (m :: * -> *).
(Base a ~ f, Traversable f, StuckBase f, BasicBase f, Recursive a,
 Corecursive a, PrettyPrintable a, Monad m) =>
(f (m a) -> m a) -> f (m a) -> m a
stuckStepM (forall a (f :: * -> *) (m :: * -> *).
(Base a ~ f, Traversable f, BasicBase f, StuckBase f, AbortBase f,
 Recursive a, Corecursive a, Monad m) =>
(f (m a) -> m a) -> f (m a) -> m a
abortStepM (forall a (f :: * -> *) (m :: * -> *).
(Base a ~ f, Traversable f, BasicBase f, SuperBase f, Recursive a,
 Corecursive a, PrettyPrintable a, Monad m) =>
(a -> a -> a)
-> (f (m a) -> m a) -> (f (m a) -> m a) -> f (m a) -> m a
superStepM UnsizedExpr -> UnsizedExpr -> UnsizedExpr
unsizedMerge UnsizedExprF (StrictAccum SizedRecursion UnsizedExpr)
-> StrictAccum SizedRecursion UnsizedExpr
evalStep (forall a (f :: * -> *).
(Base a ~ f, Traversable f, BasicBase f, StuckBase f, SuperBase f,
 AbortBase f, UnsizedBase f, Recursive a, Corecursive a, Eq a,
 PrettyPrintable a) =>
Int
-> (f (StrictAccum SizedRecursion a)
    -> StrictAccum SizedRecursion a)
-> (f (StrictAccum SizedRecursion a)
    -> StrictAccum SizedRecursion a)
-> f (StrictAccum SizedRecursion a)
-> StrictAccum SizedRecursion a
unsizedStepM Int
maxSize UnsizedExprF (StrictAccum SizedRecursion UnsizedExpr)
-> StrictAccum SizedRecursion UnsizedExpr
evalStep (forall a (f :: * -> *) (m :: * -> *).
(Base a ~ f, Traversable f, BasicBase f, SuperBase f, Recursive a,
 Corecursive a, Monad m) =>
(f (m a) -> m a) -> f (m a) -> m a
anyFunctionStepM forall {p} {a}. PrettyPrintable p => p -> a
unhandledError)))))
  {-
  debugStep :: UnsizedExprF UnsizedExpr -> UnsizedExpr
  debugStep x =
    let nx = evalStep x
        hasBad = f where
          f = \case
            BasicEE (SetEnvSF (BasicEE (PairSF (BasicEE ZeroSF) _))) -> True
            x -> getAny . foldMap (Any . f) $ project x
    in if hasBad nx
          then error ("found potential issue before:\n" <> prettyPrint x <> "\n---after---\n" <> prettyPrint nx)
          else nx
-}
  unhandledError :: p -> a
unhandledError p
x = forall a. HasCallStack => String -> a
error (String
"sizeTerm unhandled case\n" forall a. Semigroup a => a -> a -> a
<> forall p. PrettyPrintable p => p -> String
prettyPrint p
x)

convertToF :: (Base g ~ f, BasicBase f, StuckBase f, Traversable f, Corecursive g) => IExpr -> g
convertToF :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, StuckBase f, Traversable f,
 Corecursive g) =>
IExpr -> g
convertToF = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
State.evalState (forall a. Enum a => Int -> a
toEnum Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) t (x :: * -> *) a.
(Monad m, Corecursive t, x ~ Base t, Traversable x) =>
(a -> m (Base t a)) -> a -> m t
anaM' IExpr -> StateT FunctionIndex Identity (f IExpr)
f where
  f :: IExpr -> StateT FunctionIndex Identity (f IExpr)
f = \case
    IExpr
Zero     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall f. PartExprF f
ZeroSF
    Pair IExpr
a IExpr
b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> PartExprF f
PairSF IExpr
a IExpr
b
    IExpr
Env      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall f. PartExprF f
EnvSF
    SetEnv IExpr
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall a b. (a -> b) -> a -> b
$ forall f. f -> PartExprF f
SetEnvSF IExpr
x
    Defer IExpr
x  -> forall (g :: * -> *) x. StuckBase g => StuckF x -> g x
embedS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall f. FunctionIndex -> f -> StuckF f
DeferSF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State FunctionIndex FunctionIndex
nextVar forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure IExpr
x)
    Gate IExpr
l IExpr
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> PartExprF f
GateSF IExpr
l IExpr
r
    PLeft IExpr
x  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall a b. (a -> b) -> a -> b
$ forall f. f -> PartExprF f
LeftSF IExpr
x
    PRight IExpr
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall a b. (a -> b) -> a -> b
$ forall f. f -> PartExprF f
RightSF IExpr
x
    IExpr
Trace    -> forall a. HasCallStack => String -> a
error String
"EnhancedExpr trace"
  nextVar :: State FunctionIndex FunctionIndex
  nextVar :: State FunctionIndex FunctionIndex
nextVar = do
    FunctionIndex
i <- forall s (m :: * -> *). MonadState s m => m s
State.get
    forall s (m :: * -> *). MonadState s m => s -> m ()
State.put forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
succ FunctionIndex
i
    forall (f :: * -> *) a. Applicative f => a -> f a
pure FunctionIndex
i

convertFromF :: (Base g ~ f, TelomareLike g, BasicBase f, StuckBase f, Traversable f, Recursive g) => g -> Maybe IExpr
convertFromF :: forall g (f :: * -> *).
(Base g ~ f, TelomareLike g, BasicBase f, StuckBase f,
 Traversable f, Recursive g) =>
g -> Maybe IExpr
convertFromF = \case
  BasicEE PartExprF g
x -> case PartExprF g
x of
    PartExprF g
ZeroSF     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure IExpr
Zero
    PairSF g
a g
b -> IExpr -> IExpr -> IExpr
Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TelomareLike a => a -> Maybe IExpr
toTelomare g
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. TelomareLike a => a -> Maybe IExpr
toTelomare g
b
    PartExprF g
EnvSF      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure IExpr
Env
    SetEnvSF g
p -> IExpr -> IExpr
SetEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TelomareLike a => a -> Maybe IExpr
toTelomare g
p
    GateSF g
l g
r -> IExpr -> IExpr -> IExpr
Gate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TelomareLike a => a -> Maybe IExpr
toTelomare g
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. TelomareLike a => a -> Maybe IExpr
toTelomare g
r
    LeftSF g
x   -> IExpr -> IExpr
PLeft forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TelomareLike a => a -> Maybe IExpr
toTelomare g
x
    RightSF g
x  -> IExpr -> IExpr
PRight forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TelomareLike a => a -> Maybe IExpr
toTelomare g
x
  StuckEE (DeferSF FunctionIndex
_ g
x) -> IExpr -> IExpr
Defer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TelomareLike a => a -> Maybe IExpr
toTelomare g
x
  g
_ -> forall a. Maybe a
Nothing

instance TelomareLike StuckExpr where
  fromTelomare :: IExpr -> StuckExpr
fromTelomare = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, StuckBase f, Traversable f,
 Corecursive g) =>
IExpr -> g
convertToF
  toTelomare :: StuckExpr -> Maybe IExpr
toTelomare = forall g (f :: * -> *).
(Base g ~ f, TelomareLike g, BasicBase f, StuckBase f,
 Traversable f, Recursive g) =>
g -> Maybe IExpr
convertFromF

instance TelomareLike UnsizedExpr where
  fromTelomare :: IExpr -> UnsizedExpr
fromTelomare = forall g (f :: * -> *).
(Base g ~ f, BasicBase f, StuckBase f, Traversable f,
 Corecursive g) =>
IExpr -> g
convertToF
  toTelomare :: UnsizedExpr -> Maybe IExpr
toTelomare = forall g (f :: * -> *).
(Base g ~ f, TelomareLike g, BasicBase f, StuckBase f,
 Traversable f, Recursive g) =>
g -> Maybe IExpr
convertFromF

evalBU :: IExpr -> Maybe IExpr
evalBU :: IExpr -> Maybe IExpr
evalBU = StuckExpr -> Maybe IExpr
toIExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. StuckExpr -> StuckExpr
ebu forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TelomareLike a => IExpr -> a
fromTelomare where
  toIExpr :: StuckExpr -> Maybe IExpr
toIExpr = forall a. TelomareLike a => a -> Maybe IExpr
toTelomare
  ebu :: StuckExpr -> StuckExpr
  ebu :: StuckExpr -> StuckExpr
ebu = forall t (f :: * -> *).
(Base t ~ f, BasicBase f, StuckBase f, Corecursive t, Recursive t,
 Recursive t) =>
(Base t t -> t) -> t -> t
evalBottomUp (forall a (f :: * -> *).
(Base a ~ f, StuckBase f, BasicBase f, Recursive a, Corecursive a,
 PrettyPrintable a) =>
(f a -> a) -> f a -> a
stuckStep forall a. HasCallStack => a
undefined) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\StuckExpr
x -> forall a. String -> a -> a
debugTrace (String
"evalBU starting expr:\n" forall a. Semigroup a => a -> a -> a
<> forall p. PrettyPrintable p => p -> String
prettyPrint StuckExpr
x) StuckExpr
x)

evalBU' :: IExpr -> IO IExpr
evalBU' :: IExpr -> IO IExpr
evalBU' = Maybe IExpr -> IO IExpr
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. IExpr -> Maybe IExpr
evalBU where
  f :: Maybe IExpr -> IO IExpr
f = \case
    Maybe IExpr
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure IExpr
Env
    Just IExpr
x  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure IExpr
x

term4toAbortExpr :: (Base g ~ f, BasicBase f, StuckBase f, AbortBase f, Corecursive g) => Term4 -> g
term4toAbortExpr :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, StuckBase f, AbortBase f,
 Corecursive g) =>
Term4 -> g
term4toAbortExpr (Term4 Map FragIndex (Cofree (FragExprF Void) LocTag)
termMap') =
  let termMap :: Map FragIndex (FragExpr Void)
termMap = forall a anno. Corecursive a => Cofree (Base a) anno -> a
forget forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FragIndex (Cofree (FragExprF Void) LocTag)
termMap'
      convertFrag' :: FragExpr Void -> g
convertFrag' = forall t. Corecursive t => Base t t -> t
embed forall b c a. (b -> c) -> (a -> b) -> a -> c
. FragExpr Void -> f g
convertFrag
      convertFrag :: FragExpr Void -> f g
convertFrag = \case
        FragExpr Void
ZeroFrag      -> forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall f. PartExprF f
ZeroSF
        PairFrag FragExpr Void
a FragExpr Void
b  -> forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> PartExprF f
PairSF (FragExpr Void -> g
convertFrag' FragExpr Void
a) (FragExpr Void -> g
convertFrag' FragExpr Void
b)
        FragExpr Void
EnvFrag       -> forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall f. PartExprF f
EnvSF
        SetEnvFrag FragExpr Void
x  -> forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
SetEnvSF forall a b. (a -> b) -> a -> b
$ FragExpr Void -> g
convertFrag' FragExpr Void
x
        DeferFrag FragIndex
ind -> forall (g :: * -> *) x. StuckBase g => StuckF x -> g x
embedS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. FunctionIndex -> f -> StuckF f
DeferSF (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ FragIndex
ind) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FragExpr Void -> g
convertFrag' forall a b. (a -> b) -> a -> b
$ Map FragIndex (FragExpr Void)
termMap forall k a. Ord k => Map k a -> k -> a
Map.! FragIndex
ind
        FragExpr Void
AbortFrag     -> forall (g :: * -> *) x. AbortBase g => AbortableF x -> g x
embedA forall f. AbortableF f
AbortF
        GateFrag FragExpr Void
l FragExpr Void
r  -> forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall a b. (a -> b) -> a -> b
$ forall f. f -> f -> PartExprF f
GateSF (FragExpr Void -> g
convertFrag' FragExpr Void
l) (FragExpr Void -> g
convertFrag' FragExpr Void
r)
        LeftFrag FragExpr Void
x    -> forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
LeftSF forall a b. (a -> b) -> a -> b
$ FragExpr Void -> g
convertFrag' FragExpr Void
x
        RightFrag FragExpr Void
x   -> forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. f -> PartExprF f
RightSF forall a b. (a -> b) -> a -> b
$ FragExpr Void -> g
convertFrag' FragExpr Void
x
        FragExpr Void
TraceFrag     -> forall (g :: * -> *) x. BasicBase g => PartExprF x -> g x
embedB forall f. PartExprF f
EnvSF
        FragExpr Void
z             -> forall a. HasCallStack => String -> a
error (String
"term4toAbortExpr'' unexpected " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show FragExpr Void
z)
  in FragExpr Void -> g
convertFrag' (forall a. Map FragIndex a -> a
rootFrag Map FragIndex (FragExpr Void)
termMap)

abortExprToTerm4 :: (Base g ~ f, BasicBase f, StuckBase f, AbortBase f, Foldable f, Recursive g) => g -> Either IExpr Term4
abortExprToTerm4 :: forall g (f :: * -> *).
(Base g ~ f, BasicBase f, StuckBase f, AbortBase f, Foldable f,
 Recursive g) =>
g -> Either IExpr Term4
abortExprToTerm4 g
x =
  let
    dl :: f (Cofree f LocTag) -> Cofree f LocTag
dl = (LocTag
DummyLoc forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:<)
    pv :: f (Cofree f LocTag)
-> StateT
     (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
     Identity
     (Cofree f LocTag)
pv = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> *}. f (Cofree f LocTag) -> Cofree f LocTag
dl
    findAborted :: g -> Maybe IExpr
findAborted = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall a b. (a -> b) -> a -> b
$ \case
      AbortFW (AbortedF IExpr
e) -> forall a. a -> Maybe a
Just IExpr
e
      Base g (Maybe IExpr)
x                    -> forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum Base g (Maybe IExpr)
x
    convert :: f (StateT
     (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
     Identity
     (Cofree (FragExprF Void) LocTag))
-> StateT
     (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
     Identity
     (Cofree (FragExprF Void) LocTag)
convert = \case
      BasicFW PartExprF
  (StateT
     (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
     Identity
     (Cofree (FragExprF Void) LocTag))
ZeroSF        -> forall {f :: * -> *}.
f (Cofree f LocTag)
-> StateT
     (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
     Identity
     (Cofree f LocTag)
pv forall a r. FragExprF a r
ZeroFragF
      BasicFW (PairSF StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
a StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
b)  -> forall {f :: * -> *}. f (Cofree f LocTag) -> Cofree f LocTag
dl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a r. r -> r -> FragExprF a r
PairFragF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
b)
      BasicFW PartExprF
  (StateT
     (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
     Identity
     (Cofree (FragExprF Void) LocTag))
EnvSF         -> forall {f :: * -> *}.
f (Cofree f LocTag)
-> StateT
     (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
     Identity
     (Cofree f LocTag)
pv forall a r. FragExprF a r
EnvFragF
      BasicFW (SetEnvSF StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
x)  -> forall {f :: * -> *}. f (Cofree f LocTag) -> Cofree f LocTag
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a r. r -> FragExprF a r
SetEnvFragF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
x
      StuckFW (DeferSF FunctionIndex
_ StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
x) -> forall a b. Show a => BreakState' a b -> BreakState' a b
deferF StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
x
      AbortFW AbortableF
  (StateT
     (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
     Identity
     (Cofree (FragExprF Void) LocTag))
AbortF        -> forall {f :: * -> *}.
f (Cofree f LocTag)
-> StateT
     (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
     Identity
     (Cofree f LocTag)
pv forall a r. FragExprF a r
AbortFragF
      BasicFW (GateSF StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
l StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
r)  -> forall {f :: * -> *}. f (Cofree f LocTag) -> Cofree f LocTag
dl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a r. r -> r -> FragExprF a r
GateFragF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
r)
      BasicFW (LeftSF StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
x)    -> forall {f :: * -> *}. f (Cofree f LocTag) -> Cofree f LocTag
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a r. r -> FragExprF a r
LeftFragF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
x
      BasicFW (RightSF StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
x)   -> forall {f :: * -> *}. f (Cofree f LocTag) -> Cofree f LocTag
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a r. r -> FragExprF a r
RightFragF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
  Identity
  (Cofree (FragExprF Void) LocTag)
x
      f (StateT
     (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
     Identity
     (Cofree (FragExprF Void) LocTag))
z                     -> forall a. HasCallStack => String -> a
error String
"abortExprToTerm4 unexpected thing "
  in case g -> Maybe IExpr
findAborted g
x of
    Just IExpr
e -> forall a b. a -> Either a b
Left IExpr
e
    Maybe IExpr
_      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map FragIndex (Cofree (FragExprF Void) LocTag) -> Term4
Term4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
BreakState' a b -> Map FragIndex (Cofree (FragExprF a) LocTag)
buildFragMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Recursive t => (Base t a -> a) -> t -> a
cata f (StateT
     (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
     Identity
     (Cofree (FragExprF Void) LocTag))
-> StateT
     (Any, FragIndex, Map FragIndex (Cofree (FragExprF Void) LocTag))
     Identity
     (Cofree (FragExprF Void) LocTag)
convert forall a b. (a -> b) -> a -> b
$ g
x

evalA :: (Maybe IExpr -> Maybe IExpr -> Maybe IExpr) -> Maybe IExpr -> Term4 -> Maybe IExpr
evalA :: (Maybe IExpr -> Maybe IExpr -> Maybe IExpr)
-> Maybe IExpr -> Term4 -> Maybe IExpr
evalA Maybe IExpr -> Maybe IExpr -> Maybe IExpr
combine Maybe IExpr
base Term4
t =
  let unhandledError :: p -> a
unhandledError p
x = forall a. HasCallStack => String -> a
error (String
"evalA unhandled case " forall a. Semigroup a => a -> a -> a
<> forall p. PrettyPrintable p => p -> String
prettyPrint p
x)
      runResult :: SuperExpr
runResult = let aStep :: SuperExprF SuperExpr -> SuperExpr
                      aStep :: SuperExprF SuperExpr -> SuperExpr
aStep = forall a (f :: * -> *).
(Base a ~ f, StuckBase f, BasicBase f, Recursive a, Corecursive a,
 PrettyPrintable a) =>
(f a -> a) -> f a -> a
stuckStep (forall a (f :: * -> *).
(Base a ~ f, BasicBase f, SuperBase f, Recursive a, Corecursive a,
 PrettyPrintable a) =>
(a -> a -> a) -> (f a -> a) -> (f a -> a) -> f a -> a
superStep SuperExpr -> SuperExpr -> SuperExpr
aMerge SuperExprF SuperExpr -> SuperExpr
aStep (forall a (f :: * -> *).
(Base a ~ f, BasicBase f, StuckBase f, AbortBase f, Recursive a,
 Corecursive a) =>
(f a -> a) -> f a -> a
abortStep forall {p} {a}. PrettyPrintable p => p -> a
unhandledError))
                      aMerge :: SuperExpr -> SuperExpr -> SuperExpr
aMerge = forall x (f :: * -> *).
(Base x ~ f, SuperBase f, Eq x, Corecursive x, Recursive x) =>
(x -> x -> x) -> (x -> x -> x) -> x -> x -> x
mergeSuper SuperExpr -> SuperExpr -> SuperExpr
aMerge (forall x (f :: * -> *).
(Base x ~ f, AbortBase f, Eq x, Corecursive x, Recursive x) =>
(x -> x -> x) -> x -> x -> x
mergeAbort forall x (f :: * -> *).
(Base x ~ f, SuperBase f, Eq x, Corecursive x, Recursive x) =>
x -> x -> x
mergeUnknown)
                      eval' :: SuperExpr -> SuperExpr
                      eval' :: SuperExpr -> SuperExpr
eval' = forall t (f :: * -> *).
(Base t ~ f, BasicBase f, StuckBase f, Corecursive t, Recursive t,
 Recursive t) =>
(Base t t -> t) -> t -> t
evalBottomUp SuperExprF SuperExpr -> SuperExpr
aStep
                  in SuperExpr -> SuperExpr
eval' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g (f :: * -> *).
(Base g ~ f, BasicBase f, StuckBase f, SuperBase f, Recursive g,
 Corecursive g) =>
g -> g
capMain forall a b. (a -> b) -> a -> b
$ forall g (f :: * -> *).
(Base g ~ f, BasicBase f, StuckBase f, AbortBase f,
 Corecursive g) =>
Term4 -> g
term4toAbortExpr Term4
t
      getAborted :: SuperExprF (Maybe IExpr) -> Maybe IExpr
getAborted = \case
        AbortFW (AbortedF IExpr
e)   -> forall a. a -> Maybe a
Just IExpr
e
        SuperFW (EitherPF Maybe IExpr
a Maybe IExpr
b) -> Maybe IExpr -> Maybe IExpr -> Maybe IExpr
combine Maybe IExpr
a Maybe IExpr
b
        SuperExprF (Maybe IExpr)
x                      -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall a. Maybe a
Nothing SuperExprF (Maybe IExpr)
x
  in forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe IExpr -> Maybe IExpr -> Maybe IExpr
combine Maybe IExpr
base forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Recursive t => (Base t a -> a) -> t -> a
cata SuperExprF (Maybe IExpr) -> Maybe IExpr
getAborted forall a b. (a -> b) -> a -> b
$ SuperExpr
runResult