{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}

module Telomare.Eval where

import Control.Comonad.Cofree (Cofree ((:<)), hoistCofree)
import Control.Lens.Plated (Plated (..), transform, transformM)
import Control.Monad.Except (fix, runExceptT, void)
import Control.Monad.State (State, StateT, evalState)
import qualified Control.Monad.State as State
import Data.Bifunctor (bimap, first)
import Data.Functor.Foldable (Base, para)
import Data.Map (Map)
import qualified Data.Map as Map
import Debug.Trace (trace)
import PrettyPrint (prettyPrint)
import System.IO (hGetContents)
import qualified System.IO.Strict as Strict
import System.Process (CreateProcess (std_out), StdStream (CreatePipe),
                       createProcess, shell)
import Telomare
import Telomare.Optimizer (optimize)
import Telomare.Parser (AnnotatedUPT, parseOneExprOrTopLevelDefs, parsePrelude)
import Telomare.Possible (AbortExpr, abortExprToTerm4, evalA, sizeTerm,
                          term3ToUnsizedExpr)
import Telomare.Resolver (parseMain, process)
import Telomare.RunTime (pureEval, rEval)
import Telomare.TypeChecker (TypeCheckError (..), typeCheck)
import Text.Megaparsec (errorBundlePretty, runParser)

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

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

data ExpP = ZeroP
    | PairP ExpP ExpP
    | VarP
    | SetEnvP ExpP Bool
    | DeferP ExpP
    | AbortP
    | GateP ExpP ExpP
    | LeftP ExpP
    | RightP ExpP
    | TraceP
    deriving (ExpP -> ExpP -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpP -> ExpP -> Bool
$c/= :: ExpP -> ExpP -> Bool
== :: ExpP -> ExpP -> Bool
$c== :: ExpP -> ExpP -> Bool
Eq, Int -> ExpP -> ShowS
[ExpP] -> ShowS
ExpP -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ExpP] -> ShowS
$cshowList :: [ExpP] -> ShowS
show :: ExpP -> [Char]
$cshow :: ExpP -> [Char]
showsPrec :: Int -> ExpP -> ShowS
$cshowsPrec :: Int -> ExpP -> ShowS
Show, Eq ExpP
ExpP -> ExpP -> Bool
ExpP -> ExpP -> Ordering
ExpP -> ExpP -> ExpP
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 :: ExpP -> ExpP -> ExpP
$cmin :: ExpP -> ExpP -> ExpP
max :: ExpP -> ExpP -> ExpP
$cmax :: ExpP -> ExpP -> ExpP
>= :: ExpP -> ExpP -> Bool
$c>= :: ExpP -> ExpP -> Bool
> :: ExpP -> ExpP -> Bool
$c> :: ExpP -> ExpP -> Bool
<= :: ExpP -> ExpP -> Bool
$c<= :: ExpP -> ExpP -> Bool
< :: ExpP -> ExpP -> Bool
$c< :: ExpP -> ExpP -> Bool
compare :: ExpP -> ExpP -> Ordering
$ccompare :: ExpP -> ExpP -> Ordering
Ord)

instance Plated ExpP where
  plate :: Traversal' ExpP ExpP
plate ExpP -> f ExpP
f = \case
    PairP ExpP
a ExpP
b   -> ExpP -> ExpP -> ExpP
PairP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpP -> f ExpP
f ExpP
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExpP -> f ExpP
f ExpP
b
    SetEnvP ExpP
x Bool
b -> ExpP -> Bool -> ExpP
SetEnvP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpP -> f ExpP
f ExpP
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
    DeferP ExpP
x    -> ExpP -> ExpP
DeferP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpP -> f ExpP
f ExpP
x
    GateP ExpP
l ExpP
r   -> ExpP -> ExpP -> ExpP
GateP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpP -> f ExpP
f ExpP
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExpP -> f ExpP
f ExpP
r
    LeftP ExpP
x     -> ExpP -> ExpP
LeftP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpP -> f ExpP
f ExpP
x
    RightP ExpP
x    -> ExpP -> ExpP
RightP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpP -> f ExpP
f ExpP
x
    ExpP
x           -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ExpP
x

data EvalError = RTE RunTimeError
    | TCE TypeCheckError
    | StaticCheckError String
    | CompileConversionError
    | RecursionLimitError UnsizedRecursionToken
    deriving (EvalError -> EvalError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvalError -> EvalError -> Bool
$c/= :: EvalError -> EvalError -> Bool
== :: EvalError -> EvalError -> Bool
$c== :: EvalError -> EvalError -> Bool
Eq, Eq EvalError
EvalError -> EvalError -> Bool
EvalError -> EvalError -> Ordering
EvalError -> EvalError -> EvalError
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 :: EvalError -> EvalError -> EvalError
$cmin :: EvalError -> EvalError -> EvalError
max :: EvalError -> EvalError -> EvalError
$cmax :: EvalError -> EvalError -> EvalError
>= :: EvalError -> EvalError -> Bool
$c>= :: EvalError -> EvalError -> Bool
> :: EvalError -> EvalError -> Bool
$c> :: EvalError -> EvalError -> Bool
<= :: EvalError -> EvalError -> Bool
$c<= :: EvalError -> EvalError -> Bool
< :: EvalError -> EvalError -> Bool
$c< :: EvalError -> EvalError -> Bool
compare :: EvalError -> EvalError -> Ordering
$ccompare :: EvalError -> EvalError -> Ordering
Ord, Int -> EvalError -> ShowS
[EvalError] -> ShowS
EvalError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [EvalError] -> ShowS
$cshowList :: [EvalError] -> ShowS
show :: EvalError -> [Char]
$cshow :: EvalError -> [Char]
showsPrec :: Int -> EvalError -> ShowS
$cshowsPrec :: Int -> EvalError -> ShowS
Show)

type ExpFullEnv = ExprA Bool

newtype BetterMap k v = BetterMap { forall k v. BetterMap k v -> Map k v
unBetterMap :: Map k v}

instance Functor (BetterMap k) where
  fmap :: forall a b. (a -> b) -> BetterMap k a -> BetterMap k b
fmap a -> b
f (BetterMap Map k a
x) = forall k v. Map k v -> BetterMap k v
BetterMap forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Map k a
x

instance (Ord k, Semigroup m) => Semigroup (BetterMap k m) where
  <> :: BetterMap k m -> BetterMap k m -> BetterMap k m
(<>) (BetterMap Map k m
a) (BetterMap Map k m
b) = forall k v. Map k v -> BetterMap k v
BetterMap 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. Semigroup a => a -> a -> a
(<>) Map k m
a Map k m
b

annotateEnv :: IExpr -> (Bool, ExpP)
annotateEnv :: IExpr -> (Bool, ExpP)
annotateEnv IExpr
Zero = (Bool
True, ExpP
ZeroP)
annotateEnv (Pair IExpr
a IExpr
b) =
  let (Bool
at, ExpP
na) = IExpr -> (Bool, ExpP)
annotateEnv IExpr
a
      (Bool
bt, ExpP
nb) = IExpr -> (Bool, ExpP)
annotateEnv IExpr
b
  in (Bool
at Bool -> Bool -> Bool
&& Bool
bt, ExpP -> ExpP -> ExpP
PairP ExpP
na ExpP
nb)
annotateEnv IExpr
Env = (Bool
False, ExpP
VarP)
annotateEnv (SetEnv IExpr
x) = let (Bool
xt, ExpP
nx) = IExpr -> (Bool, ExpP)
annotateEnv IExpr
x in (Bool
xt, ExpP -> Bool -> ExpP
SetEnvP ExpP
nx Bool
xt)
annotateEnv (Defer IExpr
x) = let (Bool
_, ExpP
nx) = IExpr -> (Bool, ExpP)
annotateEnv IExpr
x in (Bool
True, ExpP -> ExpP
DeferP ExpP
nx)
annotateEnv (Gate IExpr
a IExpr
b) =
  let (Bool
at, ExpP
na) = IExpr -> (Bool, ExpP)
annotateEnv IExpr
a
      (Bool
bt, ExpP
nb) = IExpr -> (Bool, ExpP)
annotateEnv IExpr
b
  in (Bool
at Bool -> Bool -> Bool
&& Bool
bt, ExpP -> ExpP -> ExpP
GateP ExpP
na ExpP
nb)
annotateEnv (PLeft IExpr
x) = ExpP -> ExpP
LeftP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IExpr -> (Bool, ExpP)
annotateEnv IExpr
x
annotateEnv (PRight IExpr
x) = ExpP -> ExpP
RightP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IExpr -> (Bool, ExpP)
annotateEnv IExpr
x
annotateEnv IExpr
Trace = (Bool
False, ExpP
TraceP)

fromFullEnv :: (ExpP -> IExpr) -> ExpP -> IExpr
fromFullEnv :: (ExpP -> IExpr) -> ExpP -> IExpr
fromFullEnv ExpP -> IExpr
_ ExpP
ZeroP         = IExpr
Zero
fromFullEnv ExpP -> IExpr
f (PairP ExpP
a ExpP
b)   = IExpr -> IExpr -> IExpr
Pair (ExpP -> IExpr
f ExpP
a) (ExpP -> IExpr
f ExpP
b)
fromFullEnv ExpP -> IExpr
_ ExpP
VarP          = IExpr
Env
fromFullEnv ExpP -> IExpr
f (SetEnvP ExpP
x Bool
_) = IExpr -> IExpr
SetEnv (ExpP -> IExpr
f ExpP
x)
fromFullEnv ExpP -> IExpr
f (DeferP ExpP
x)    = IExpr -> IExpr
Defer (ExpP -> IExpr
f ExpP
x)
fromFullEnv ExpP -> IExpr
f (GateP ExpP
a ExpP
b)   = IExpr -> IExpr -> IExpr
Gate (ExpP -> IExpr
f ExpP
a) (ExpP -> IExpr
f ExpP
b)
fromFullEnv ExpP -> IExpr
f (LeftP ExpP
x)     = IExpr -> IExpr
PLeft (ExpP -> IExpr
f ExpP
x)
fromFullEnv ExpP -> IExpr
f (RightP ExpP
x)    = IExpr -> IExpr
PRight (ExpP -> IExpr
f ExpP
x)
fromFullEnv ExpP -> IExpr
_ ExpP
TraceP        = IExpr
Trace

instance TelomareLike ExpP where
  fromTelomare :: IExpr -> ExpP
fromTelomare = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. IExpr -> (Bool, ExpP)
annotateEnv
  toTelomare :: ExpP -> Maybe IExpr
toTelomare = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> a
fix (ExpP -> IExpr) -> ExpP -> IExpr
fromFullEnv

partiallyEvaluate :: ExpP -> IExpr
partiallyEvaluate :: ExpP -> IExpr
partiallyEvaluate se :: ExpP
se@(SetEnvP ExpP
_ Bool
True) = IExpr -> IExpr
Defer (IExpr -> IExpr
pureEval forall b c a. (b -> c) -> (a -> b) -> a -> c
. IExpr -> IExpr
optimize forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a
fix (ExpP -> IExpr) -> ExpP -> IExpr
fromFullEnv ExpP
se)
partiallyEvaluate ExpP
x = (ExpP -> IExpr) -> ExpP -> IExpr
fromFullEnv ExpP -> IExpr
partiallyEvaluate ExpP
x

convertPT :: (UnsizedRecursionToken -> Int) -> Term3 -> Term4
convertPT :: (UnsizedRecursionToken -> Int) -> Term3 -> Term4
convertPT UnsizedRecursionToken -> Int
ll (Term3 Map FragIndex FragExprUR
termMap) =
  let unURedMap :: Map FragIndex (Cofree (FragExprF RecursionPieceFrag) LocTag)
unURedMap = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map FragExprUR -> Cofree (FragExprF RecursionPieceFrag) LocTag
unFragExprUR Map FragIndex FragExprUR
termMap
      startKey :: FragIndex
startKey = forall a. Enum a => a -> a
succ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> (k, a)
Map.findMax Map FragIndex FragExprUR
termMap
      changeFrag :: Cofree (FragExprF RecursionPieceFrag) LocTag
                 -> State.State
                      ((), FragIndex,
                       Map
                         FragIndex
                         (Cofree (FragExprF RecursionPieceFrag) LocTag))
                      (Cofree (FragExprF RecursionPieceFrag) LocTag)
      changeFrag :: Cofree (FragExprF RecursionPieceFrag) LocTag
-> State
     ((), FragIndex,
      Map FragIndex (Cofree (FragExprF RecursionPieceFrag) LocTag))
     (Cofree (FragExprF RecursionPieceFrag) LocTag)
changeFrag = \case
        LocTag
anno :< AuxFragF (NestedSetEnvs UnsizedRecursionToken
n) -> forall a b. LocTag -> Int -> BreakState' a b
innerChurchF LocTag
anno forall a b. (a -> b) -> a -> b
$ UnsizedRecursionToken -> Int
ll UnsizedRecursionToken
n
        LocTag
_ :< AuxFragF (SizingWrapper UnsizedRecursionToken
_ FragExprUR
x) -> forall (m :: * -> *) a.
(Monad m, Plated a) =>
(a -> m a) -> a -> m a
transformM Cofree (FragExprF RecursionPieceFrag) LocTag
-> State
     ((), FragIndex,
      Map FragIndex (Cofree (FragExprF RecursionPieceFrag) LocTag))
     (Cofree (FragExprF RecursionPieceFrag) LocTag)
changeFrag forall a b. (a -> b) -> a -> b
$ FragExprUR -> Cofree (FragExprF RecursionPieceFrag) LocTag
unFragExprUR FragExprUR
x
        Cofree (FragExprF RecursionPieceFrag) LocTag
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Cofree (FragExprF RecursionPieceFrag) LocTag
x
      insertChanged :: FragIndex
                    -> Cofree (FragExprF RecursionPieceFrag) LocTag
                    -> BreakState RecursionPieceFrag () ()
      insertChanged :: FragIndex
-> Cofree (FragExprF RecursionPieceFrag) LocTag
-> BreakState RecursionPieceFrag () ()
insertChanged FragIndex
nk Cofree (FragExprF RecursionPieceFrag) LocTag
nv = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (\(()
_, FragIndex
k, Map FragIndex (Cofree (FragExprF RecursionPieceFrag) LocTag)
m) -> ((), FragIndex
k, forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FragIndex
nk Cofree (FragExprF RecursionPieceFrag) LocTag
nv Map FragIndex (Cofree (FragExprF RecursionPieceFrag) LocTag)
m))
      builder :: StateT
  ((), FragIndex,
   Map FragIndex (Cofree (FragExprF RecursionPieceFrag) LocTag))
  Identity
  (Map FragIndex ())
builder = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\FragIndex
k Cofree (FragExprF RecursionPieceFrag) LocTag
v -> forall (m :: * -> *) a.
(Monad m, Plated a) =>
(a -> m a) -> a -> m a
transformM Cofree (FragExprF RecursionPieceFrag) LocTag
-> State
     ((), FragIndex,
      Map FragIndex (Cofree (FragExprF RecursionPieceFrag) LocTag))
     (Cofree (FragExprF RecursionPieceFrag) LocTag)
changeFrag Cofree (FragExprF RecursionPieceFrag) LocTag
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FragIndex
-> Cofree (FragExprF RecursionPieceFrag) LocTag
-> BreakState RecursionPieceFrag () ()
insertChanged FragIndex
k) Map FragIndex (Cofree (FragExprF RecursionPieceFrag) LocTag)
unURedMap
      (()
_,FragIndex
_,Map FragIndex (Cofree (FragExprF RecursionPieceFrag) LocTag)
newMap) = forall s a. State s a -> s -> s
State.execState StateT
  ((), FragIndex,
   Map FragIndex (Cofree (FragExprF RecursionPieceFrag) LocTag))
  Identity
  (Map FragIndex ())
builder ((), FragIndex
startKey, Map FragIndex (Cofree (FragExprF RecursionPieceFrag) LocTag)
unURedMap)
      changeType :: FragExprF a x -> FragExprF b x
      changeType :: forall a x b. FragExprF a x -> FragExprF b x
changeType = \case
        FragExprF a x
ZeroFragF      -> forall a r. FragExprF a r
ZeroFragF
        PairFragF x
a x
b  -> forall a r. r -> r -> FragExprF a r
PairFragF x
a x
b
        FragExprF a x
EnvFragF       -> forall a r. FragExprF a r
EnvFragF
        SetEnvFragF x
x  -> forall a r. r -> FragExprF a r
SetEnvFragF x
x
        DeferFragF FragIndex
ind -> forall a r. FragIndex -> FragExprF a r
DeferFragF FragIndex
ind
        FragExprF a x
AbortFragF     -> forall a r. FragExprF a r
AbortFragF
        GateFragF x
l x
r  -> forall a r. r -> r -> FragExprF a r
GateFragF x
l x
r
        LeftFragF x
x    -> forall a r. r -> FragExprF a r
LeftFragF x
x
        RightFragF x
x   -> forall a r. r -> FragExprF a r
RightFragF x
x
        FragExprF a x
TraceFragF     -> forall a r. FragExprF a r
TraceFragF
        AuxFragF a
z     -> forall a. HasCallStack => [Char] -> a
error [Char]
"convertPT should be no AuxFrags here TODO"
  in Map FragIndex (Cofree (FragExprF Void) LocTag) -> Term4
Term4 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
(forall x. f x -> g x) -> Cofree f a -> Cofree g a
hoistCofree forall a x b. FragExprF a x -> FragExprF b x
changeType) Map FragIndex (Cofree (FragExprF RecursionPieceFrag) LocTag)
newMap

findChurchSize :: Term3 -> Either EvalError Term4
findChurchSize :: Term3 -> Either EvalError Term4
findChurchSize = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnsizedRecursionToken -> Int) -> Term3 -> Term4
convertPT (forall a b. a -> b -> a
const Int
255)
-- findChurchSize = calculateRecursionLimits -- works fine for unit tests, but uses too much memory for tictactoe

-- we should probably redo the types so that this is also a type conversion
removeChecks :: Term4 -> Term4
removeChecks :: Term4 -> Term4
removeChecks (Term4 Map FragIndex (Cofree (FragExprF Void) LocTag)
m) =
  let f :: Cofree (FragExprF a) a -> Cofree (FragExprF a) a
f = \case
        a
anno :< FragExprF a (Cofree (FragExprF a) a)
AbortFragF -> a
anno forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall a r. FragIndex -> FragExprF a r
DeferFragF FragIndex
ind
        Cofree (FragExprF a) a
x                  -> Cofree (FragExprF a) a
x
      (FragIndex
ind, Map FragIndex (Cofree (FragExprF Void) LocTag)
newM) = forall s a. State s a -> s -> (a, s)
State.runState forall {a}.
StateT
  (Map FragIndex (Cofree (FragExprF a) LocTag)) Identity FragIndex
builder Map FragIndex (Cofree (FragExprF Void) LocTag)
m
      builder :: StateT
  (Map FragIndex (Cofree (FragExprF a) LocTag)) Identity FragIndex
builder = do
        FragIndex
envDefer <- forall e a. (Ord e, Enum e) => a -> State (Map e a) e
insertAndGetKey forall a b. (a -> b) -> a -> b
$ LocTag
DummyLoc forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall a r. FragExprF a r
EnvFragF
        forall e a. (Ord e, Enum e) => a -> State (Map e a) e
insertAndGetKey forall a b. (a -> b) -> a -> b
$ LocTag
DummyLoc forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall a r. FragIndex -> FragExprF a r
DeferFragF FragIndex
envDefer
  in Map FragIndex (Cofree (FragExprF Void) LocTag) -> Term4
Term4 forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall a. Plated a => (a -> a) -> a -> a
transform forall {a} {a}. Cofree (FragExprF a) a -> Cofree (FragExprF a) a
f) Map FragIndex (Cofree (FragExprF Void) LocTag)
newM

convertAbortMessage :: IExpr -> String
convertAbortMessage :: IExpr -> [Char]
convertAbortMessage = \case
  IExpr
AbortRecursion -> [Char]
"recursion overflow (should be caught by other means)"
  AbortUser IExpr
s -> [Char]
"user abort: " forall a. Semigroup a => a -> a -> a
<> IExpr -> [Char]
g2s IExpr
s
  IExpr
AbortAny -> [Char]
"user abort of all possible abort reasons (non-deterministic input)"
  IExpr
x -> [Char]
"unexpected abort: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show IExpr
x

runStaticChecks :: Term4 -> Either EvalError Term4
runStaticChecks :: Term4 -> Either EvalError Term4
runStaticChecks t :: Term4
t@(Term4 Map FragIndex (Cofree (FragExprF Void) LocTag)
termMap) =
  let result :: Maybe IExpr
result = (Maybe IExpr -> Maybe IExpr -> Maybe IExpr)
-> Maybe IExpr -> Term4 -> Maybe IExpr
evalA forall {a} {a}. Maybe a -> Maybe a -> Maybe a
combine (forall a. a -> Maybe a
Just IExpr
Zero) Term4
t
      combine :: Maybe a -> Maybe a -> Maybe a
combine Maybe a
a Maybe a
b = case (Maybe a
a,Maybe a
b) of
        (Maybe a
Nothing, Maybe a
_) -> forall a. Maybe a
Nothing
        (Maybe a
_, Maybe a
Nothing) -> forall a. Maybe a
Nothing
        (Maybe a
a, Maybe a
_)       -> Maybe a
a
  in case Maybe IExpr
result of
    Maybe IExpr
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term4
t
    Just IExpr
e  -> forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> EvalError
StaticCheckError forall a b. (a -> b) -> a -> b
$ IExpr -> [Char]
convertAbortMessage IExpr
e

compileMain :: Term3 -> Either EvalError IExpr
compileMain :: Term3 -> Either EvalError IExpr
compileMain Term3
term = case PartialType -> Term3 -> Maybe TypeCheckError
typeCheck (PartialType -> PartialType -> PartialType
PairTypeP (PartialType -> PartialType -> PartialType
ArrTypeP PartialType
ZeroTypeP PartialType
ZeroTypeP) PartialType
AnyType) Term3
term of
  Just TypeCheckError
e -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ TypeCheckError -> EvalError
TCE TypeCheckError
e
  Maybe TypeCheckError
_      -> (Term4 -> Either EvalError Term4)
-> Term3 -> Either EvalError IExpr
compile forall (f :: * -> *) a. Applicative f => a -> f a
pure Term3
term -- TODO add runStaticChecks back in

compileUnitTest :: Term3 -> Either EvalError IExpr
compileUnitTest :: Term3 -> Either EvalError IExpr
compileUnitTest = (Term4 -> Either EvalError Term4)
-> Term3 -> Either EvalError IExpr
compile Term4 -> Either EvalError Term4
runStaticChecks

compile :: (Term4 -> Either EvalError Term4) -> Term3 -> Either EvalError IExpr
compile :: (Term4 -> Either EvalError Term4)
-> Term3 -> Either EvalError IExpr
compile Term4 -> Either EvalError Term4
staticCheck Term3
t = forall a. [Char] -> a -> a
debugTrace ([Char]
"compiling term3:\n" forall a. Semigroup a => a -> a -> a
<> forall p. PrettyPrintable p => p -> [Char]
prettyPrint Term3
t)
  forall a b. (a -> b) -> a -> b
$ case forall a. TelomareLike a => a -> Maybe IExpr
toTelomare forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term4 -> Term4
removeChecks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term3 -> Either EvalError Term4
findChurchSize Term3
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Term4 -> Either EvalError Term4
staticCheck) of
      Right (Just IExpr
i) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure IExpr
i
      Right Maybe IExpr
Nothing  -> forall a b. a -> Either a b
Left EvalError
CompileConversionError
      Left EvalError
e         -> forall a b. a -> Either a b
Left EvalError
e

-- converts between easily understood Haskell types and untyped IExprs around an iteration of a Telomare expression
funWrap :: (IExpr -> IExpr) -> IExpr -> Maybe (String, IExpr) -> (String, Maybe IExpr)
funWrap :: (IExpr -> IExpr)
-> IExpr -> Maybe ([Char], IExpr) -> ([Char], Maybe IExpr)
funWrap IExpr -> IExpr
eval IExpr
fun Maybe ([Char], IExpr)
inp =
  let iexpInp :: IExpr
iexpInp = case Maybe ([Char], IExpr)
inp of
        Maybe ([Char], IExpr)
Nothing                  -> IExpr
Zero
        Just ([Char]
userInp, IExpr
oldState) -> IExpr -> IExpr -> IExpr
Pair ([Char] -> IExpr
s2g [Char]
userInp) IExpr
oldState
  in case IExpr -> IExpr
eval (IExpr -> IExpr -> IExpr
app IExpr
fun IExpr
iexpInp) of
    IExpr
Zero               -> ([Char]
"aborted", forall a. Maybe a
Nothing)
    Pair IExpr
disp IExpr
newState -> (IExpr -> [Char]
g2s IExpr
disp, forall a. a -> Maybe a
Just IExpr
newState)
    IExpr
z                  -> ([Char]
"runtime error, dumped:\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show IExpr
z, forall a. Maybe a
Nothing)

runMainCore :: String -> String -> (IExpr -> IO a) -> IO a
runMainCore :: forall a. [Char] -> [Char] -> (IExpr -> IO a) -> IO a
runMainCore [Char]
preludeString [Char]
s IExpr -> IO a
e =
  let prelude :: [(String, AnnotatedUPT)]
      prelude :: [([Char], AnnotatedUPT)]
prelude =
        case [Char] -> Either [Char] [([Char], AnnotatedUPT)]
parsePrelude [Char]
preludeString of
          Right [([Char], AnnotatedUPT)]
p -> [([Char], AnnotatedUPT)]
p
          Left [Char]
pe -> forall a. HasCallStack => [Char] -> a
error [Char]
pe
  in
    case Term3 -> Either EvalError IExpr
compileMain forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], AnnotatedUPT)] -> [Char] -> Either [Char] Term3
parseMain [([Char], AnnotatedUPT)]
prelude [Char]
s of
      Left [Char]
e -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"failed to parse ", [Char]
s, [Char]
" ", [Char]
e]
      Right (Right IExpr
g) -> IExpr -> IO a
e IExpr
g
      Right Either EvalError IExpr
z -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"compilation failed somehow, with result " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Either EvalError IExpr
z

runMain_ :: String -> String -> IO String
runMain_ :: [Char] -> [Char] -> IO [Char]
runMain_ [Char]
preludeString [Char]
s = forall a. [Char] -> [Char] -> (IExpr -> IO a) -> IO a
runMainCore [Char]
preludeString [Char]
s IExpr -> IO [Char]
evalLoop_

runMain :: String -> String -> IO ()
runMain :: [Char] -> [Char] -> IO ()
runMain [Char]
preludeString [Char]
s = forall a. [Char] -> [Char] -> (IExpr -> IO a) -> IO a
runMainCore [Char]
preludeString [Char]
s IExpr -> IO ()
evalLoop

schemeEval :: IExpr -> IO ()
schemeEval :: IExpr -> IO ()
schemeEval IExpr
iexpr = do
  [Char] -> [Char] -> IO ()
writeFile [Char]
"scheme.txt" (Char
'(' forall a. a -> [a] -> [a]
: (forall a. Show a => a -> [Char]
show (IExpr -> IExpr -> IExpr
app IExpr
iexpr IExpr
Zero) forall a. Semigroup a => a -> a -> a
<> [Char]
")"))
  (Maybe Handle
_, Just Handle
mhout, Maybe Handle
_, ProcessHandle
_) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess ([Char] -> CreateProcess
shell [Char]
"chez-script runtime.so") { std_out :: StdStream
std_out = StdStream
CreatePipe }
  [Char]
scheme <- Handle -> IO [Char]
hGetContents Handle
mhout
  [Char] -> IO ()
putStrLn [Char]
scheme

evalLoopCore :: IExpr
             -> (String -> String -> IO String)
             -> String
             -> [String]
             -> IO String
evalLoopCore :: IExpr
-> ([Char] -> [Char] -> IO [Char])
-> [Char]
-> [[Char]]
-> IO [Char]
evalLoopCore IExpr
iexpr [Char] -> [Char] -> IO [Char]
accumFn [Char]
initAcc [[Char]]
manualInput =
  let wrappedEval :: Maybe (String, IExpr) -> (String, Maybe IExpr)
      wrappedEval :: Maybe ([Char], IExpr) -> ([Char], Maybe IExpr)
wrappedEval = (IExpr -> IExpr)
-> IExpr -> Maybe ([Char], IExpr) -> ([Char], Maybe IExpr)
funWrap forall a. AbstractRunTime a => a -> a
eval IExpr
iexpr
      mainLoop :: String -> [String] -> Maybe (String, IExpr) -> IO String
      mainLoop :: [Char] -> [[Char]] -> Maybe ([Char], IExpr) -> IO [Char]
mainLoop [Char]
acc [[Char]]
strInput Maybe ([Char], IExpr)
s = do
        let ([Char]
out, Maybe IExpr
nextState) = Maybe ([Char], IExpr) -> ([Char], Maybe IExpr)
wrappedEval Maybe ([Char], IExpr)
s
        [Char]
newAcc <- [Char] -> [Char] -> IO [Char]
accumFn [Char]
acc [Char]
out
        case Maybe IExpr
nextState of
          Maybe IExpr
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
acc
          Just IExpr
Zero -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Char]
newAcc forall a. Semigroup a => a -> a -> a
<> [Char]
"\n" forall a. Semigroup a => a -> a -> a
<> [Char]
"done"
          Just IExpr
ns -> do
            ([Char]
inp, [[Char]]
rest) <-
              if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
strInput
              then (, []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Char]
getLine
              else forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. [a] -> a
head [[Char]]
strInput, forall a. [a] -> [a]
tail [[Char]]
strInput)
            [Char] -> [[Char]] -> Maybe ([Char], IExpr) -> IO [Char]
mainLoop [Char]
newAcc [[Char]]
rest forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
inp, IExpr
ns)
  in [Char] -> [[Char]] -> Maybe ([Char], IExpr) -> IO [Char]
mainLoop [Char]
initAcc [[Char]]
manualInput forall a. Maybe a
Nothing

evalLoop :: IExpr -> IO ()
evalLoop :: IExpr -> IO ()
evalLoop IExpr
iexpr = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ IExpr
-> ([Char] -> [Char] -> IO [Char])
-> [Char]
-> [[Char]]
-> IO [Char]
evalLoopCore IExpr
iexpr forall {p}. p -> [Char] -> IO [Char]
printAcc [Char]
"" []
  where
    printAcc :: p -> [Char] -> IO [Char]
printAcc p
_ [Char]
out = do
      [Char] -> IO ()
putStrLn [Char]
out
      forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
""

evalLoopWithInput :: [String] -> IExpr -> IO String
evalLoopWithInput :: [[Char]] -> IExpr -> IO [Char]
evalLoopWithInput [[Char]]
inputList IExpr
iexpr = IExpr
-> ([Char] -> [Char] -> IO [Char])
-> [Char]
-> [[Char]]
-> IO [Char]
evalLoopCore IExpr
iexpr forall {f :: * -> *}. Applicative f => [Char] -> [Char] -> f [Char]
printAcc [Char]
"" [[Char]]
inputList
  where
    printAcc :: [Char] -> [Char] -> f [Char]
printAcc [Char]
acc [Char]
out = if [Char]
acc forall a. Eq a => a -> a -> Bool
== [Char]
""
                       then forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
out
                       else forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
acc forall a. Semigroup a => a -> a -> a
<> [Char]
"\n" forall a. Semigroup a => a -> a -> a
<> [Char]
out)

runMainWithInput :: [String] -> String -> String -> IO String
runMainWithInput :: [[Char]] -> [Char] -> [Char] -> IO [Char]
runMainWithInput [[Char]]
inputList [Char]
preludeString [Char]
s =
  let prelude :: [(String, AnnotatedUPT)]
      prelude :: [([Char], AnnotatedUPT)]
prelude =
        case [Char] -> Either [Char] [([Char], AnnotatedUPT)]
parsePrelude [Char]
preludeString of
          Right [([Char], AnnotatedUPT)]
p -> [([Char], AnnotatedUPT)]
p
          Left [Char]
pe -> forall a. HasCallStack => [Char] -> a
error [Char]
pe
  in
    case Term3 -> Either EvalError IExpr
compileMain forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], AnnotatedUPT)] -> [Char] -> Either [Char] Term3
parseMain [([Char], AnnotatedUPT)]
prelude [Char]
s of
      Left [Char]
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"failed to parse ", [Char]
s, [Char]
" ", [Char]
e]
      Right (Right IExpr
g) -> [[Char]] -> IExpr -> IO [Char]
evalLoopWithInput [[Char]]
inputList IExpr
g
      Right Either EvalError IExpr
z -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Char]
"compilation failed somehow, with result " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Either EvalError IExpr
z

-- |Same as `evalLoop`, but keeping what was displayed.
evalLoop_ :: IExpr -> IO String
evalLoop_ :: IExpr -> IO [Char]
evalLoop_ IExpr
iexpr = IExpr
-> ([Char] -> [Char] -> IO [Char])
-> [Char]
-> [[Char]]
-> IO [Char]
evalLoopCore IExpr
iexpr forall {f :: * -> *}. Applicative f => [Char] -> [Char] -> f [Char]
printAcc [Char]
"" []
  where
    printAcc :: [Char] -> [Char] -> f [Char]
printAcc [Char]
acc [Char]
out = if [Char]
acc forall a. Eq a => a -> a -> Bool
== [Char]
""
                       then forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
out
                       else forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
acc forall a. Semigroup a => a -> a -> a
<> [Char]
"\n" forall a. Semigroup a => a -> a -> a
<> [Char]
out)

calculateRecursionLimits :: Term3 -> Either EvalError Term4
calculateRecursionLimits :: Term3 -> Either EvalError Term4
calculateRecursionLimits Term3
t3 =
  let abortExprToTerm4' :: AbortExpr -> Either IExpr Term4
      abortExprToTerm4' :: AbortExpr -> 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
      limitSize :: Int
limitSize = Int
256
  in case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AbortExpr -> Either IExpr Term4
abortExprToTerm4' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UnsizedExpr -> Either UnsizedRecursionToken AbortExpr
sizeTerm Int
limitSize forall a b. (a -> b) -> a -> b
$ Int -> Term3 -> UnsizedExpr
term3ToUnsizedExpr Int
limitSize Term3
t3 of
    Left UnsizedRecursionToken
urt -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ UnsizedRecursionToken -> EvalError
RecursionLimitError UnsizedRecursionToken
urt
    Right Either IExpr Term4
t  -> case Either IExpr Term4
t of
      Left IExpr
a  -> forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> EvalError
StaticCheckError forall b c a. (b -> c) -> (a -> b) -> a -> c
. IExpr -> [Char]
convertAbortMessage forall a b. (a -> b) -> a -> b
$ IExpr
a
      Right Term4
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Term4
t

eval2IExpr :: [(String, AnnotatedUPT)] -> String -> Either String IExpr
eval2IExpr :: [([Char], AnnotatedUPT)] -> [Char] -> Either [Char] IExpr
eval2IExpr [([Char], AnnotatedUPT)]
prelude [Char]
str = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> [Char]
errorBundlePretty (\AnnotatedUPT
x -> LocTag
DummyLoc forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. [([Char], r)] -> r -> UnprocessedParsedTermF r
LetUPF [([Char], AnnotatedUPT)]
prelude AnnotatedUPT
x) (forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser ([([Char], AnnotatedUPT)] -> TelomareParser AnnotatedUPT
parseOneExprOrTopLevelDefs [([Char], AnnotatedUPT)]
prelude) [Char]
"" [Char]
str)
                           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [([Char], AnnotatedUPT)] -> AnnotatedUPT -> Either [Char] Term3
process [([Char], AnnotatedUPT)]
prelude
                           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term3 -> Either EvalError IExpr
compileUnitTest

tagIExprWithEval :: IExpr -> Cofree IExprF (Int, IExpr)
tagIExprWithEval :: IExpr -> Cofree IExprF (Int, IExpr)
tagIExprWithEval IExpr
iexpr = forall s a. State s a -> s -> a
evalState (forall t a. Recursive t => (Base t (t, a) -> a) -> t -> a
para Base IExpr (IExpr, State Int (Cofree IExprF (Int, IExpr)))
-> State Int (Cofree IExprF (Int, IExpr))
alg IExpr
iexpr) Int
0 where
  statePlus1 :: State Int Int
  statePlus1 :: State Int Int
statePlus1 = do
      Int
i <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
  alg :: Base IExpr
              ( IExpr
              , State Int (Cofree IExprF (Int, IExpr))
              )
      -> State Int (Cofree IExprF (Int, IExpr))
  alg :: Base IExpr (IExpr, State Int (Cofree IExprF (Int, IExpr)))
-> State Int (Cofree IExprF (Int, IExpr))
alg = \case
    Base IExpr (IExpr, State Int (Cofree IExprF (Int, IExpr)))
IExprF (IExpr, State Int (Cofree IExprF (Int, IExpr)))
ZeroF -> do
      Int
i <- State Int Int
statePlus1
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int
i, IExpr -> IExpr -> IExpr
rEval IExpr
Zero IExpr
Zero) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. IExprF r
ZeroF)
    Base IExpr (IExpr, State Int (Cofree IExprF (Int, IExpr)))
IExprF (IExpr, State Int (Cofree IExprF (Int, IExpr)))
EnvF -> do
      Int
i <- State Int Int
statePlus1
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int
i, IExpr -> IExpr -> IExpr
rEval IExpr
Zero IExpr
Env) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. IExprF r
EnvF)
    Base IExpr (IExpr, State Int (Cofree IExprF (Int, IExpr)))
IExprF (IExpr, State Int (Cofree IExprF (Int, IExpr)))
TraceF -> do
      Int
i <- State Int Int
statePlus1
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int
i, IExpr -> IExpr -> IExpr
rEval IExpr
Zero IExpr
Trace) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. IExprF r
TraceF)
    SetEnvF (IExpr
iexpr0, State Int (Cofree IExprF (Int, IExpr))
x) -> do
      Int
i <- State Int Int
statePlus1
      Cofree IExprF (Int, IExpr)
x' <- State Int (Cofree IExprF (Int, IExpr))
x
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, IExpr -> IExpr -> IExpr
rEval IExpr
Zero forall a b. (a -> b) -> a -> b
$ IExpr -> IExpr
SetEnv IExpr
iexpr0) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. r -> IExprF r
SetEnvF Cofree IExprF (Int, IExpr)
x'
    DeferF (IExpr
iexpr0, State Int (Cofree IExprF (Int, IExpr))
x) -> do
      Int
i <- State Int Int
statePlus1
      Cofree IExprF (Int, IExpr)
x' <- State Int (Cofree IExprF (Int, IExpr))
x
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, IExpr -> IExpr -> IExpr
rEval IExpr
Zero forall a b. (a -> b) -> a -> b
$ IExpr -> IExpr
Defer IExpr
iexpr0) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. r -> IExprF r
DeferF Cofree IExprF (Int, IExpr)
x'
    PLeftF (IExpr
iexpr0, State Int (Cofree IExprF (Int, IExpr))
x) -> do
      Int
i <- State Int Int
statePlus1
      Cofree IExprF (Int, IExpr)
x' <- State Int (Cofree IExprF (Int, IExpr))
x
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, IExpr -> IExpr -> IExpr
rEval IExpr
Zero forall a b. (a -> b) -> a -> b
$ IExpr -> IExpr
PLeft IExpr
iexpr0) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. r -> IExprF r
PLeftF Cofree IExprF (Int, IExpr)
x'
    PRightF (IExpr
iexpr0, State Int (Cofree IExprF (Int, IExpr))
x) -> do
      Int
i <- State Int Int
statePlus1
      Cofree IExprF (Int, IExpr)
x' <- State Int (Cofree IExprF (Int, IExpr))
x
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, IExpr -> IExpr -> IExpr
rEval IExpr
Zero forall a b. (a -> b) -> a -> b
$ IExpr -> IExpr
PRight IExpr
iexpr0) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. r -> IExprF r
PRightF Cofree IExprF (Int, IExpr)
x'
    PairF (IExpr
iexpr0, State Int (Cofree IExprF (Int, IExpr))
x) (IExpr
iexpr1, State Int (Cofree IExprF (Int, IExpr))
y) -> do
      Int
i <- State Int Int
statePlus1
      Cofree IExprF (Int, IExpr)
x' <- State Int (Cofree IExprF (Int, IExpr))
x
      Cofree IExprF (Int, IExpr)
y' <- State Int (Cofree IExprF (Int, IExpr))
y
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, IExpr -> IExpr -> IExpr
rEval IExpr
Zero forall a b. (a -> b) -> a -> b
$ IExpr -> IExpr -> IExpr
Pair IExpr
iexpr0 IExpr
iexpr1) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. r -> r -> IExprF r
PairF Cofree IExprF (Int, IExpr)
x' Cofree IExprF (Int, IExpr)
y'
    GateF (IExpr
iexpr0, State Int (Cofree IExprF (Int, IExpr))
x) (IExpr
iexpr1, State Int (Cofree IExprF (Int, IExpr))
y) -> do
      Int
i <- State Int Int
statePlus1
      Cofree IExprF (Int, IExpr)
x' <- State Int (Cofree IExprF (Int, IExpr))
x
      Cofree IExprF (Int, IExpr)
y' <- State Int (Cofree IExprF (Int, IExpr))
y
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, IExpr -> IExpr -> IExpr
rEval IExpr
Zero forall a b. (a -> b) -> a -> b
$ IExpr -> IExpr -> IExpr
Gate IExpr
iexpr0 IExpr
iexpr1) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. r -> r -> IExprF r
GateF Cofree IExprF (Int, IExpr)
x' Cofree IExprF (Int, IExpr)
y'

tagUPTwithIExpr :: [(String, AnnotatedUPT)]
                -> UnprocessedParsedTerm
                -> Cofree UnprocessedParsedTermF (Int, Either String IExpr)
tagUPTwithIExpr :: [([Char], AnnotatedUPT)]
-> UnprocessedParsedTerm
-> Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
tagUPTwithIExpr [([Char], AnnotatedUPT)]
prelude UnprocessedParsedTerm
upt = forall s a. State s a -> s -> a
evalState (forall t a. Recursive t => (Base t (t, a) -> a) -> t -> a
para Base
  UnprocessedParsedTerm
  (UnprocessedParsedTerm,
   State
     Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)))
-> State
     Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
alg UnprocessedParsedTerm
upt) Int
0 where
  upt2iexpr :: UnprocessedParsedTerm -> Either String IExpr
  upt2iexpr :: UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr UnprocessedParsedTerm
u = [([Char], AnnotatedUPT)] -> AnnotatedUPT -> Either [Char] Term3
process [([Char], AnnotatedUPT)]
prelude (forall a anno. Recursive a => anno -> a -> Cofree (Base a) anno
tag LocTag
DummyLoc UnprocessedParsedTerm
u) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term3 -> Either EvalError IExpr
compileUnitTest
  alg :: Base UnprocessedParsedTerm
              ( UnprocessedParsedTerm
              , State Int (Cofree UnprocessedParsedTermF (Int, Either String IExpr))
              )
      -> State Int (Cofree UnprocessedParsedTermF (Int, Either String IExpr))
  alg :: Base
  UnprocessedParsedTerm
  (UnprocessedParsedTerm,
   State
     Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)))
-> State
     Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
alg = \case
    ITEUPF (UnprocessedParsedTerm
utp1, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x) (UnprocessedParsedTerm
utp2, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
y) (UnprocessedParsedTerm
utp3, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
z) -> do
      Int
i <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
y' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
y
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
z' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
z
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr forall a b. (a -> b) -> a -> b
$ UnprocessedParsedTerm
-> UnprocessedParsedTerm
-> UnprocessedParsedTerm
-> UnprocessedParsedTerm
ITEUP UnprocessedParsedTerm
utp1 UnprocessedParsedTerm
utp2 UnprocessedParsedTerm
utp3) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. r -> r -> r -> UnprocessedParsedTermF r
ITEUPF Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
y' Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
z'
    ListUPF [(UnprocessedParsedTerm,
  State
    Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)))]
l -> do
      Int
i <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      let scupt :: State Int [Cofree UnprocessedParsedTermF (Int, Either String IExpr)]
          scupt :: State
  Int [Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)]
scupt = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a b. (a, b) -> b
snd [(UnprocessedParsedTerm,
  State
    Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)))]
l
      [Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)]
cupt <- State
  Int [Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)]
scupt
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UnprocessedParsedTerm] -> UnprocessedParsedTerm
ListUP forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnprocessedParsedTerm,
  State
    Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)))]
l) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. [r] -> UnprocessedParsedTermF r
ListUPF [Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)]
cupt
    LetUPF [([Char],
  (UnprocessedParsedTerm,
   State
     Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))))]
l (UnprocessedParsedTerm
upt0, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x) -> do
      Int
i <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      let lupt :: [(String, UnprocessedParsedTerm)]
          lupt :: [([Char], UnprocessedParsedTerm)]
lupt = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) forall a b. (a, b) -> a
fst [([Char],
  (UnprocessedParsedTerm,
   State
     Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))))]
l
          slcupt :: State Int
                     [Cofree UnprocessedParsedTermF (Int, Either String IExpr)]
          slcupt :: State
  Int [Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)]
slcupt = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a b. (a, b) -> b
snd (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char],
  (UnprocessedParsedTerm,
   State
     Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))))]
l)
          vnames :: [String]
          vnames :: [[Char]]
vnames = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char],
  (UnprocessedParsedTerm,
   State
     Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))))]
l
      [Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)]
lcupt <- State
  Int [Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)]
slcupt
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr forall a b. (a -> b) -> a -> b
$ [([Char], UnprocessedParsedTerm)]
-> UnprocessedParsedTerm -> UnprocessedParsedTerm
LetUP [([Char], UnprocessedParsedTerm)]
lupt UnprocessedParsedTerm
upt0) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. [([Char], r)] -> r -> UnprocessedParsedTermF r
LetUPF ([[Char]]
vnames forall a b. [a] -> [b] -> [(a, b)]
`zip` [Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)]
lcupt) Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x'
    CaseUPF (UnprocessedParsedTerm
upt0, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x) [(Pattern,
  (UnprocessedParsedTerm,
   State
     Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))))]
l -> do
      Int
i <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x
      let aux :: [ ( Pattern
                   , UnprocessedParsedTerm
                   )
                 ]
          aux :: [(Pattern, UnprocessedParsedTerm)]
aux = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) forall a b. (a, b) -> a
fst [(Pattern,
  (UnprocessedParsedTerm,
   State
     Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))))]
l
          aux0 :: [(Pattern,
  State
    Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)))]
aux0 = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) forall a b. (a, b) -> b
snd [(Pattern,
  (UnprocessedParsedTerm,
   State
     Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))))]
l
          aux1 :: State Int
                    [ ( Pattern
                      , Cofree UnprocessedParsedTermF (Int, Either String IExpr)
                      )
                    ]
          aux1 :: State
  Int
  [(Pattern,
    Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))]
aux1 = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [(Pattern,
  State
    Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)))]
aux0
      [(Pattern,
  Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))]
aux1' <- State
  Int
  [(Pattern,
    Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))]
aux1
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr forall a b. (a -> b) -> a -> b
$ UnprocessedParsedTerm
-> [(Pattern, UnprocessedParsedTerm)] -> UnprocessedParsedTerm
CaseUP UnprocessedParsedTerm
upt0 [(Pattern, UnprocessedParsedTerm)]
aux) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. r -> [(Pattern, r)] -> UnprocessedParsedTermF r
CaseUPF Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' [(Pattern,
  Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))]
aux1'
    LamUPF [Char]
s (UnprocessedParsedTerm
upt0, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x) -> do
      Int
i <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr forall a b. (a -> b) -> a -> b
$ [Char] -> UnprocessedParsedTerm -> UnprocessedParsedTerm
LamUP [Char]
s UnprocessedParsedTerm
upt0) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. [Char] -> r -> UnprocessedParsedTermF r
LamUPF [Char]
s Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x'
    AppUPF (UnprocessedParsedTerm
upt1, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x) (UnprocessedParsedTerm
upt2, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
y) -> do
      Int
i <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
y' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
y
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr forall a b. (a -> b) -> a -> b
$ UnprocessedParsedTerm
-> UnprocessedParsedTerm -> UnprocessedParsedTerm
AppUP UnprocessedParsedTerm
upt1 UnprocessedParsedTerm
upt2) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. r -> r -> UnprocessedParsedTermF r
AppUPF Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
y'
    UnsizedRecursionUPF (UnprocessedParsedTerm
upt1, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x) (UnprocessedParsedTerm
upt2, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
y) (UnprocessedParsedTerm
upt3, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
z) -> do
      Int
i <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
y' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
y
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
z' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
z
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr forall a b. (a -> b) -> a -> b
$
                   UnprocessedParsedTerm
-> UnprocessedParsedTerm
-> UnprocessedParsedTerm
-> UnprocessedParsedTerm
UnsizedRecursionUP UnprocessedParsedTerm
upt1 UnprocessedParsedTerm
upt2 UnprocessedParsedTerm
upt3) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:<
                     forall r. r -> r -> r -> UnprocessedParsedTermF r
UnsizedRecursionUPF Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
y' Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
z'
    CheckUPF (UnprocessedParsedTerm
upt1, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x) (UnprocessedParsedTerm
upt2, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
y) -> do
      Int
i <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
y' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
y
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr forall a b. (a -> b) -> a -> b
$ UnprocessedParsedTerm
-> UnprocessedParsedTerm -> UnprocessedParsedTerm
CheckUP UnprocessedParsedTerm
upt1 UnprocessedParsedTerm
upt2) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. r -> r -> UnprocessedParsedTermF r
CheckUPF Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
y'
    LeftUPF (UnprocessedParsedTerm
upt0, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x) -> do
      Int
i <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr forall a b. (a -> b) -> a -> b
$ UnprocessedParsedTerm -> UnprocessedParsedTerm
LeftUP UnprocessedParsedTerm
upt0) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. r -> UnprocessedParsedTermF r
LeftUPF Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x'
    RightUPF (UnprocessedParsedTerm
upt0, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x) -> do
      Int
i <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr forall a b. (a -> b) -> a -> b
$ UnprocessedParsedTerm -> UnprocessedParsedTerm
RightUP UnprocessedParsedTerm
upt0) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. r -> UnprocessedParsedTermF r
RightUPF Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x'
    TraceUPF (UnprocessedParsedTerm
upt0, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x) -> do
      Int
i <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr forall a b. (a -> b) -> a -> b
$ UnprocessedParsedTerm -> UnprocessedParsedTerm
TraceUP UnprocessedParsedTerm
upt0) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. r -> UnprocessedParsedTermF r
TraceUPF Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x'
    HashUPF (UnprocessedParsedTerm
upt0, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x) -> do
      Int
i <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr forall a b. (a -> b) -> a -> b
$ UnprocessedParsedTerm -> UnprocessedParsedTerm
LeftUP UnprocessedParsedTerm
upt0) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. r -> UnprocessedParsedTermF r
LeftUPF Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x'
    IntUPF Int
i -> do
      Int
x <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int
x, UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr forall a b. (a -> b) -> a -> b
$ Int -> UnprocessedParsedTerm
IntUP Int
i) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. Int -> UnprocessedParsedTermF r
IntUPF Int
i)
    VarUPF [Char]
s -> do
      Int
x <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int
x, UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr forall a b. (a -> b) -> a -> b
$ [Char] -> UnprocessedParsedTerm
VarUP [Char]
s) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. [Char] -> UnprocessedParsedTermF r
VarUPF [Char]
s)
    PairUPF (UnprocessedParsedTerm
upt1, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x) (UnprocessedParsedTerm
upt2, State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
y) -> do
      Int
i <- forall s (m :: * -> *). MonadState s m => m s
State.get
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+ Int
1)
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
x
      Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
y' <- State
  Int (Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr))
y
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Int
i, UnprocessedParsedTerm -> Either [Char] IExpr
upt2iexpr forall a b. (a -> b) -> a -> b
$ UnprocessedParsedTerm
-> UnprocessedParsedTerm -> UnprocessedParsedTerm
PairUP UnprocessedParsedTerm
upt1 UnprocessedParsedTerm
upt2) forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< forall r. r -> r -> UnprocessedParsedTermF r
PairUPF Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
x' Cofree UnprocessedParsedTermF (Int, Either [Char] IExpr)
y'