{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Unison.Runtime.ANF
( minimizeCyclesOrCrash,
pattern TVar,
pattern TLit,
pattern TBLit,
pattern TApp,
pattern TApv,
pattern TCom,
pattern TCon,
pattern TKon,
pattern TReq,
pattern TPrm,
pattern TFOp,
pattern THnd,
pattern TLet,
pattern TLetD,
pattern TFrc,
pattern TLets,
pattern TName,
pattern TBind,
pattern TBinds,
pattern TShift,
pattern TMatch,
CompileExn (..),
internalBug,
Mem (..),
Lit (..),
Direction (..),
SuperNormal (..),
SuperGroup (..),
POp (..),
FOp,
close,
saturate,
float,
floatGroup,
lamLift,
lamLiftGroup,
litRef,
inlineAlias,
addDefaultCases,
ANormalF (.., AApv, ACom, ACon, AKon, AReq, APrm, AFOp),
ANormal,
RTag,
CTag,
Tag (..),
GroupRef (..),
Value (..),
Cont (..),
BLit (..),
packTags,
unpackTags,
maskTags,
ANFM,
Branched (.., MatchDataCover),
Func (..),
SGEqv (..),
equivocate,
superNormalize,
anfTerm,
valueTermLinks,
valueLinks,
groupTermLinks,
foldGroupLinks,
overGroupLinks,
traverseGroupLinks,
normalLinks,
prettyGroup,
prettySuperNormal,
prettyANF,
)
where
import Control.Exception (throw)
import Control.Lens (snoc, unsnoc)
import Control.Monad.Reader (ReaderT (..), ask, local)
import Control.Monad.State (MonadState (..), State, gets, modify, runState)
import Data.Bifoldable (Bifoldable (..))
import Data.Bitraversable (Bitraversable (..))
import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import Data.Functor.Compose (Compose (..))
import Data.List hiding (and, or)
import Data.Map qualified as Map
import Data.Primitive qualified as PA
import Data.Set qualified as Set
import Data.Text qualified as Data.Text
import GHC.Stack (CallStack, callStack)
import Unison.ABT qualified as ABT
import Unison.ABT.Normalized qualified as ABTN
import Unison.Blank (nameb)
import Unison.Builtin.Decls qualified as Ty
import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
import Unison.Hashing.V2.Convert (hashTermComponentsWithoutTypes)
import Unison.Pattern (SeqOp (..))
import Unison.Pattern qualified as P
import Unison.Prelude
import Unison.Reference (Id, Reference, Reference' (Builtin, DerivedId))
import Unison.Referent (Referent, pattern Con, pattern Ref)
import Unison.Symbol (Symbol)
import Unison.Term hiding (List, Ref, Text, float, fresh, resolve)
import Unison.Type qualified as Ty
import Unison.Typechecker.Components (minimize')
import Unison.Util.Bytes (Bytes)
import Unison.Util.EnumContainers as EC
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Text qualified as Util.Text
import Unison.Var (Var, typed)
import Unison.Var qualified as Var
import Prelude hiding (abs, and, or, seq)
import Prelude qualified
data CompileExn = CE CallStack (Pretty.Pretty Pretty.ColorText)
deriving (Int -> CompileExn -> ShowS
[CompileExn] -> ShowS
CompileExn -> String
(Int -> CompileExn -> ShowS)
-> (CompileExn -> String)
-> ([CompileExn] -> ShowS)
-> Show CompileExn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompileExn -> ShowS
showsPrec :: Int -> CompileExn -> ShowS
$cshow :: CompileExn -> String
show :: CompileExn -> String
$cshowList :: [CompileExn] -> ShowS
showList :: [CompileExn] -> ShowS
Show)
instance Exception CompileExn
internalBug :: (HasCallStack) => String -> a
internalBug :: forall a. HasCallStack => String -> a
internalBug = CompileExn -> a
forall a e. Exception e => e -> a
throw (CompileExn -> a) -> (String -> CompileExn) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> Pretty ColorText -> CompileExn
CE CallStack
HasCallStack => CallStack
callStack (Pretty ColorText -> CompileExn)
-> (String -> Pretty ColorText) -> String -> CompileExn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColorText -> Pretty ColorText
forall s. (IsString s, ListLike s Char) => s -> Pretty s
Pretty.lit (ColorText -> Pretty ColorText)
-> (String -> ColorText) -> String -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ColorText
forall a. IsString a => String -> a
fromString
closure :: (Var v) => Map v (Set v, Set v) -> Map v (Set v)
closure :: forall v. Var v => Map v (Set v, Set v) -> Map v (Set v)
closure Map v (Set v, Set v)
m0 = Map v (Set v) -> Map v (Set v)
trace ((Set v, Set v) -> Set v
forall a b. (a, b) -> b
snd ((Set v, Set v) -> Set v) -> Map v (Set v, Set v) -> Map v (Set v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map v (Set v, Set v)
m0)
where
refs :: Map v (Set v)
refs = (Set v, Set v) -> Set v
forall a b. (a, b) -> a
fst ((Set v, Set v) -> Set v) -> Map v (Set v, Set v) -> Map v (Set v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map v (Set v, Set v)
m0
expand :: Map k a -> a -> t k -> a
expand Map k a
acc a
fvs t k
rvs =
a
fvs a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (k -> a) -> t k -> a
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\k
r -> a -> k -> Map k a -> a
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault a
forall a. Monoid a => a
mempty k
r Map k a
acc) t k
rvs
trace :: Map v (Set v) -> Map v (Set v)
trace Map v (Set v)
acc
| Map v (Set v)
acc Map v (Set v) -> Map v (Set v) -> Bool
forall a. Eq a => a -> a -> Bool
== Map v (Set v)
acc' = Map v (Set v)
acc
| Bool
otherwise = Map v (Set v) -> Map v (Set v)
trace Map v (Set v)
acc'
where
acc' :: Map v (Set v)
acc' = (Set v -> Set v -> Set v)
-> Map v (Set v) -> Map v (Set v) -> Map v (Set v)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (Map v (Set v) -> Set v -> Set v -> Set v
forall {a} {t :: * -> *} {k}.
(Foldable t, Monoid a, Ord k) =>
Map k a -> a -> t k -> a
expand Map v (Set v)
acc) Map v (Set v)
acc Map v (Set v)
refs
expandRec ::
(Var v, Monoid a) =>
Set v ->
[(v, Term v a)] ->
[(v, Term v a)]
expandRec :: forall v a.
(Var v, Monoid a) =>
Set v -> [(v, Term v a)] -> [(v, Term v a)]
expandRec Set v
keep [(v, Term v a)]
vbs = (v, [v]) -> (v, Term v a)
forall {v} {a} {vt} {at} {ap}.
(Ord v, Monoid a) =>
(v, [v]) -> (v, Term2 vt at ap v a)
mkSub ((v, [v]) -> (v, Term v a)) -> [(v, [v])] -> [(v, Term v a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, [v])]
fvl
where
mkSub :: (v, [v]) -> (v, Term2 vt at ap v a)
mkSub (v
v, [v]
fvs) = (v
v, Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' (a -> v -> Term2 vt at ap v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
forall a. Monoid a => a
mempty v
v) (a -> v -> Term2 vt at ap v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
forall a. Monoid a => a
mempty (v -> Term2 vt at ap v a) -> [v] -> [Term2 vt at ap v a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
fvs))
fvl :: [(v, [v])]
fvl =
Map v [v] -> [(v, [v])]
forall k a. Map k a -> [(k, a)]
Map.toList
(Map v [v] -> [(v, [v])])
-> (Map v (Set v, Set v) -> Map v [v])
-> Map v (Set v, Set v)
-> [(v, [v])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set v -> [v]) -> Map v (Set v) -> Map v [v]
forall a b. (a -> b) -> Map v a -> Map v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set v -> [v]
forall a. Set a -> [a]
Set.toList)
(Map v (Set v) -> Map v [v])
-> (Map v (Set v, Set v) -> Map v (Set v))
-> Map v (Set v, Set v)
-> Map v [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map v (Set v, Set v) -> Map v (Set v)
forall v. Var v => Map v (Set v, Set v) -> Map v (Set v)
closure
(Map v (Set v, Set v) -> [(v, [v])])
-> Map v (Set v, Set v) -> [(v, [v])]
forall a b. (a -> b) -> a -> b
$ (v -> Bool) -> Set v -> (Set v, Set v)
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
Set.partition (v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set v
keep)
(Set v -> (Set v, Set v))
-> (Term v a -> Set v) -> Term v a -> (Set v, Set v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v a -> Set v
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars
(Term v a -> (Set v, Set v))
-> Map v (Term v a) -> Map v (Set v, Set v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, Term v a)] -> Map v (Term v a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v, Term v a)]
vbs
expandSimple ::
(Var v, Monoid a) =>
Set v ->
(v, Term v a) ->
(v, Term v a)
expandSimple :: forall v a.
(Var v, Monoid a) =>
Set v -> (v, Term v a) -> (v, Term v a)
expandSimple Set v
keep (v
v, Term v a
bnd) = (v
v, Term v a -> [Term v a] -> Term v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' (a -> v -> Term v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
a v
v) [Term v a]
evs)
where
a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
bnd
fvs :: Set v
fvs = Term v a -> Set v
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars Term v a
bnd
evs :: [Term v a]
evs = (v -> Term v a) -> [v] -> [Term v a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> v -> Term v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
a) ([v] -> [Term v a]) -> (Set v -> [v]) -> Set v -> [Term v a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set v -> [v]
forall a. Set a -> [a]
Set.toList (Set v -> [Term v a]) -> Set v -> [Term v a]
forall a b. (a -> b) -> a -> b
$ Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set v
fvs Set v
keep
abstract :: (Var v) => Set v -> Term v a -> Term v a
abstract :: forall v a. Var v => Set v -> Term v a -> Term v a
abstract Set v
keep Term v a
bnd = a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
evs Term v a
bnd
where
a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
bnd
fvs :: Set v
fvs = Term v a -> Set v
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars Term v a
bnd
evs :: [v]
evs = Set v -> [v]
forall a. Set a -> [a]
Set.toList (Set v -> [v]) -> Set v -> [v]
forall a b. (a -> b) -> a -> b
$ Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set v
fvs Set v
keep
enclose ::
(Var v, Monoid a) =>
Set v ->
(Set v -> Term v a -> Term v a) ->
Term v a ->
Maybe (Term v a)
enclose :: forall v a.
(Var v, Monoid a) =>
Set v
-> (Set v -> Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
enclose Set v
keep Set v -> Term v a -> Term v a
rec (LetRecNamedTop' Bool
top [(v, Term v a)]
vbs Term v a
bd) =
Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ Bool -> [(v, a, Term v a)] -> Term v a -> Term v a
forall v a vt.
(Ord v, Monoid a) =>
Bool -> [(v, a, Term' vt v a)] -> Term' vt v a -> Term' vt v a
letRec' Bool
top [(v, a, Term v a)]
lvbs Term v a
lbd
where
xpnd :: [(v, Term v a)]
xpnd = Set v -> [(v, Term v a)] -> [(v, Term v a)]
forall v a.
(Var v, Monoid a) =>
Set v -> [(v, Term v a)] -> [(v, Term v a)]
expandRec Set v
keep' [(v, Term v a)]
vbs
keep' :: Set v
keep' = Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set v
keep (Set v -> Set v)
-> ([(v, Term v a)] -> Set v) -> [(v, Term v a)] -> Set v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([v] -> Set v)
-> ([(v, Term v a)] -> [v]) -> [(v, Term v a)] -> Set v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v, Term v a) -> v) -> [(v, Term v a)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (v, Term v a) -> v
forall a b. (a, b) -> a
fst ([(v, Term v a)] -> Set v) -> [(v, Term v a)] -> Set v
forall a b. (a -> b) -> a -> b
$ [(v, Term v a)]
vbs
lvbs :: [(v, a, Term v a)]
lvbs =
[(v, Term v a)]
vbs
[(v, Term v a)]
-> ((v, Term v a) -> (v, a, Term v a)) -> [(v, a, Term v a)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(v
v, Term v a
trm) ->
(v
v, Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
trm, (Set v -> Term v a -> Term v a
rec Set v
keep' (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set v -> Term v a -> Term v a
forall v a. Var v => Set v -> Term v a -> Term v a
abstract Set v
keep' (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(v, Term v a)] -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v a)] -> Term f v a -> Term f v a
ABT.substs [(v, Term v a)]
xpnd) Term v a
trm)
lbd :: Term v a
lbd = Set v -> Term v a -> Term v a
rec Set v
keep' (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(v, Term v a)] -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v a)] -> Term f v a -> Term f v a
ABT.substs [(v, Term v a)]
xpnd (Term v a -> Term v a) -> Term v a -> Term v a
forall a b. (a -> b) -> a -> b
$ Term v a
bd
enclose Set v
keep Set v -> Term v a -> Term v a
rec (Let1NamedTop' Bool
top v
v b :: Term v a
b@(Term v a -> Term v a
forall v a. Term v a -> Term v a
unAnn -> LamsNamed' [v]
vs Term v a
bd) Term v a
e) =
Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a))
-> (Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [(v, Term v a)] -> Term v a -> Term v a
forall a v vt at ap.
(Semigroup a, Ord v) =>
Bool
-> [(v, Term2 vt at ap v a)]
-> Term2 vt at ap v a
-> Term2 vt at ap v a
let1' Bool
top [(v
v, Term v a
lamb)] (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set v -> Term v a -> Term v a
rec (v -> Set v -> Set v
forall a. Ord a => a -> Set a -> Set a
Set.insert v
v Set v
keep) (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$
v -> Term v a -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
v -> Term f v a -> Term f v a -> Term f v a
ABT.subst v
v Term v a
av Term v a
e
where
(v
_, Term v a
av) = Set v -> (v, Term v a) -> (v, Term v a)
forall v a.
(Var v, Monoid a) =>
Set v -> (v, Term v a) -> (v, Term v a)
expandSimple Set v
keep (v
v, Term v a
b)
keep' :: Set v
keep' = Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set v
keep (Set v -> Set v) -> Set v -> Set v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [v]
vs
fvs :: Set v
fvs = Term v a -> Set v
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars Term v a
b
evs :: [v]
evs = Set v -> [v]
forall a. Set a -> [a]
Set.toList (Set v -> [v]) -> Set v -> [v]
forall a b. (a -> b) -> a -> b
$ Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set v
fvs Set v
keep
a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
b
lbody :: Term v a
lbody = Set v -> Term v a -> Term v a
rec Set v
keep' Term v a
bd
annotate :: Term v a -> Term v a
annotate Term v a
tm
| Ann' Term v a
_ Type v a
ty <- Term v a
b = a -> Term v a -> Type v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Type vt at -> Term2 vt at ap v a
ann a
a Term v a
tm Type v a
ty
| Bool
otherwise = Term v a
tm
lamb :: Term v a
lamb = a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
evs (Term v a -> Term v a
annotate (Term v a -> Term v a) -> Term v a -> Term v a
forall a b. (a -> b) -> a -> b
$ a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
vs Term v a
lbody)
enclose Set v
keep Set v -> Term v a -> Term v a
rec t :: Term v a
t@(Term v a -> Maybe ([v], Maybe (Type v a), [v], Term v a)
forall v a.
Term v a -> Maybe ([v], Maybe (Type v a), [v], Term v a)
unLamsAnnot -> Just ([v]
vs0, Maybe (Type v a)
mty, [v]
vs1, Term v a
body)) =
Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ if [v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
evs then Term v a
lamb else Term v a -> [Term v a] -> Term v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' Term v a
lamb ([Term v a] -> Term v a) -> [Term v a] -> Term v a
forall a b. (a -> b) -> a -> b
$ (v -> Term v a) -> [v] -> [Term v a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> v -> Term v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
a) [v]
evs
where
keep' :: Set v
keep' = Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set v
keep (Set v -> Set v) -> Set v -> Set v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([v]
vs0 [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
++ [v]
vs1)
fvs :: Set v
fvs = Term v a -> Set v
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars Term v a
t
evs :: [v]
evs = Set v -> [v]
forall a. Set a -> [a]
Set.toList (Set v -> [v]) -> Set v -> [v]
forall a b. (a -> b) -> a -> b
$ Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set v
fvs Set v
keep
a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
t
lbody :: Term v a
lbody = Set v -> Term v a -> Term v a
rec Set v
keep' Term v a
body
annotate :: Term v a -> Term v a
annotate Term v a
tm
| Just Type v a
ty <- Maybe (Type v a)
mty = a -> Term v a -> Type v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Type vt at -> Term2 vt at ap v a
ann a
a Term v a
tm Type v a
ty
| Bool
otherwise = Term v a
tm
lamb :: Term v a
lamb = a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a ([v]
evs [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
++ [v]
vs0) (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v a -> Term v a
annotate (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
vs1 (Term v a -> Term v a) -> Term v a -> Term v a
forall a b. (a -> b) -> a -> b
$ Term v a
lbody
enclose Set v
keep Set v -> Term v a -> Term v a
rec t :: Term v a
t@(Handle' Term v a
h Term v a
body)
| Term v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term v a
body =
Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a))
-> (Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Term v a -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
handle (Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
t) (Set v -> Term v a -> Term v a
rec Set v
keep Term v a
h) (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ Term v a -> [Term v a] -> Term v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' Term v a
lamb [Term v a]
args
where
fvs :: Set v
fvs = Term v a -> Set v
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars Term v a
body
evs :: [v]
evs = Set v -> [v]
forall a. Set a -> [a]
Set.toList (Set v -> [v]) -> Set v -> [v]
forall a b. (a -> b) -> a -> b
$ Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set v
fvs Set v
keep
a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
body
lbody :: Term v a
lbody = Set v -> Term v a -> Term v a
rec Set v
keep Term v a
body
fv :: v
fv = Set v -> v -> v
forall v. Var v => Set v -> v -> v
Var.freshIn Set v
fvs (v -> v) -> v -> v
forall a b. (a -> b) -> a -> b
$ Type -> v
forall v. Var v => Type -> v
typed Type
Var.Eta
args :: [Term v a]
args
| [v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
evs = [a -> ConstructorReference -> Term v a
forall v a vt at ap.
Ord v =>
a -> ConstructorReference -> Term2 vt at ap v a
constructor a
a (Reference -> Word64 -> ConstructorReference
forall r. r -> Word64 -> GConstructorReference r
ConstructorReference Reference
Ty.unitRef Word64
0)]
| Bool
otherwise = a -> v -> Term v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
a (v -> Term v a) -> [v] -> [Term v a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
evs
lamb :: Term v a
lamb
| [v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
evs = a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v
fv] Term v a
lbody
| Bool
otherwise = a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
evs Term v a
lbody
enclose Set v
keep Set v -> Term v a -> Term v a
rec t :: Term v a
t@(Match' Term v a
s0 [MatchCase a (Term v a)]
cs0) = Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ a -> Term v a -> [MatchCase a (Term v a)] -> Term v a
forall v a vt at.
Ord v =>
a
-> Term2 vt at a v a
-> [MatchCase a (Term2 vt at a v a)]
-> Term2 vt at a v a
match a
a Term v a
s [MatchCase a (Term v a)]
cs
where
a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
t
s :: Term v a
s = Set v -> Term v a -> Term v a
rec Set v
keep Term v a
s0
cs :: [MatchCase a (Term v a)]
cs = a
-> Set v
-> (Set v -> Term v a -> Term v a)
-> MatchCase a (Term v a)
-> MatchCase a (Term v a)
forall v a.
(Var v, Monoid a) =>
a
-> Set v
-> (Set v -> Term v a -> Term v a)
-> MatchCase a (Term v a)
-> MatchCase a (Term v a)
encloseCase a
a Set v
keep Set v -> Term v a -> Term v a
rec (MatchCase a (Term v a) -> MatchCase a (Term v a))
-> [MatchCase a (Term v a)] -> [MatchCase a (Term v a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MatchCase a (Term v a)]
cs0
enclose Set v
_ Set v -> Term v a -> Term v a
_ Term v a
_ = Maybe (Term v a)
forall a. Maybe a
Nothing
encloseCase ::
(Var v, Monoid a) =>
a ->
Set v ->
(Set v -> Term v a -> Term v a) ->
MatchCase a (Term v a) ->
MatchCase a (Term v a)
encloseCase :: forall v a.
(Var v, Monoid a) =>
a
-> Set v
-> (Set v -> Term v a -> Term v a)
-> MatchCase a (Term v a)
-> MatchCase a (Term v a)
encloseCase a
a Set v
keep Set v -> Term v a -> Term v a
rec0 (MatchCase Pattern a
pats Maybe (Term v a)
guard Term v a
body) =
Pattern a -> Maybe (Term v a) -> Term v a -> MatchCase a (Term v a)
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
MatchCase Pattern a
pats (Term v a -> Term v a
rec (Term v a -> Term v a) -> Maybe (Term v a) -> Maybe (Term v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Term v a)
guard) (Term v a -> Term v a
rec Term v a
body)
where
rec :: Term v a -> Term v a
rec (ABT.AbsN' [v]
vs Term v a
bd) =
[(a, v)] -> Term v a -> Term v a
forall v a (f :: * -> *).
Ord v =>
[(a, v)] -> Term f v a -> Term f v a
ABT.absChain' ((,) a
a (v -> (a, v)) -> [v] -> [(a, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
vs) (Term v a -> Term v a) -> Term v a -> Term v a
forall a b. (a -> b) -> a -> b
$
Set v -> Term v a -> Term v a
rec0 (Set v
keep Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [v]
vs) Term v a
bd
newtype Prefix v x = Pfx (Map v [v]) deriving (Int -> Prefix v x -> ShowS
[Prefix v x] -> ShowS
Prefix v x -> String
(Int -> Prefix v x -> ShowS)
-> (Prefix v x -> String)
-> ([Prefix v x] -> ShowS)
-> Show (Prefix v x)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v x. Show v => Int -> Prefix v x -> ShowS
forall v x. Show v => [Prefix v x] -> ShowS
forall v x. Show v => Prefix v x -> String
$cshowsPrec :: forall v x. Show v => Int -> Prefix v x -> ShowS
showsPrec :: Int -> Prefix v x -> ShowS
$cshow :: forall v x. Show v => Prefix v x -> String
show :: Prefix v x -> String
$cshowList :: forall v x. Show v => [Prefix v x] -> ShowS
showList :: [Prefix v x] -> ShowS
Show)
instance Functor (Prefix v) where
fmap :: forall a b. (a -> b) -> Prefix v a -> Prefix v b
fmap a -> b
_ (Pfx Map v [v]
m) = Map v [v] -> Prefix v b
forall v x. Map v [v] -> Prefix v x
Pfx Map v [v]
m
instance (Ord v) => Applicative (Prefix v) where
pure :: forall a. a -> Prefix v a
pure a
_ = Map v [v] -> Prefix v a
forall v x. Map v [v] -> Prefix v x
Pfx Map v [v]
forall k a. Map k a
Map.empty
Pfx Map v [v]
ml <*> :: forall a b. Prefix v (a -> b) -> Prefix v a -> Prefix v b
<*> Pfx Map v [v]
mr = Map v [v] -> Prefix v b
forall v x. Map v [v] -> Prefix v x
Pfx (Map v [v] -> Prefix v b) -> Map v [v] -> Prefix v b
forall a b. (a -> b) -> a -> b
$ ([v] -> [v] -> [v]) -> Map v [v] -> Map v [v] -> Map v [v]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [v] -> [v] -> [v]
forall v. Eq v => [v] -> [v] -> [v]
common Map v [v]
ml Map v [v]
mr
common :: (Eq v) => [v] -> [v] -> [v]
common :: forall v. Eq v => [v] -> [v] -> [v]
common (v
u : [v]
us) (v
v : [v]
vs)
| v
u v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v = v
u v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v] -> [v] -> [v]
forall v. Eq v => [v] -> [v] -> [v]
common [v]
us [v]
vs
common [v]
_ [v]
_ = []
splitPfx :: v -> [Term v a] -> (Prefix v x, [Term v a])
splitPfx :: forall v a x. v -> [Term v a] -> (Prefix v x, [Term v a])
splitPfx v
v = ([v] -> Prefix v x)
-> ([v], [Term v a]) -> (Prefix v x, [Term v a])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Map v [v] -> Prefix v x
forall v x. Map v [v] -> Prefix v x
Pfx (Map v [v] -> Prefix v x)
-> ([v] -> Map v [v]) -> [v] -> Prefix v x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> [v] -> Map v [v]
forall k a. k -> a -> Map k a
Map.singleton v
v) (([v], [Term v a]) -> (Prefix v x, [Term v a]))
-> ([Term v a] -> ([v], [Term v a]))
-> [Term v a]
-> (Prefix v x, [Term v a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Term v a] -> ([v], [Term v a])
forall {f :: * -> *} {a} {a}. [Term f a a] -> ([a], [Term f a a])
split
where
split :: [Term f a a] -> ([a], [Term f a a])
split (Var' a
u : [Term f a a]
as) = ([a] -> [a]) -> ([a], [Term f a a]) -> ([a], [Term f a a])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (a
u a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], [Term f a a]) -> ([a], [Term f a a]))
-> ([a], [Term f a a]) -> ([a], [Term f a a])
forall a b. (a -> b) -> a -> b
$ [Term f a a] -> ([a], [Term f a a])
split [Term f a a]
as
split [Term f a a]
rest = ([], [Term f a a]
rest)
prefix :: (Ord v) => Term v a -> Prefix v (Term v a)
prefix :: forall v a. Ord v => Term v a -> Prefix v (Term v a)
prefix = (Term (F v a a) v a -> Maybe (Prefix v (Term (F v a a) v a)))
-> Term (F v a a) v a -> Prefix v (Term (F v a a) v a)
forall (f :: * -> *) (g :: * -> *) v a.
(Traversable f, Applicative g, Ord v) =>
(Term f v a -> Maybe (g (Term f v a)))
-> Term f v a -> g (Term f v a)
ABT.visit \case
Apps' (Var' v
u) [Term (F v a a) v a]
as -> case v
-> [Term (F v a a) v a]
-> (Prefix v (Term (F v a a) v a), [Term (F v a a) v a])
forall v a x. v -> [Term v a] -> (Prefix v x, [Term v a])
splitPfx v
u [Term (F v a a) v a]
as of
(Prefix v (Term (F v a a) v a)
pf, [Term (F v a a) v a]
rest) -> Prefix v (Term (F v a a) v a)
-> Maybe (Prefix v (Term (F v a a) v a))
forall a. a -> Maybe a
Just (Prefix v (Term (F v a a) v a)
-> Maybe (Prefix v (Term (F v a a) v a)))
-> Prefix v (Term (F v a a) v a)
-> Maybe (Prefix v (Term (F v a a) v a))
forall a b. (a -> b) -> a -> b
$ (Term (F v a a) v a -> Prefix v (Term (F v a a) v a))
-> [Term (F v a a) v a] -> Prefix v [Term (F v a a) v a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Term (F v a a) v a -> Prefix v (Term (F v a a) v a)
forall v a. Ord v => Term v a -> Prefix v (Term v a)
prefix [Term (F v a a) v a]
rest Prefix v [Term (F v a a) v a]
-> Prefix v (Term (F v a a) v a) -> Prefix v (Term (F v a a) v a)
forall a b. Prefix v a -> Prefix v b -> Prefix v b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Prefix v (Term (F v a a) v a)
pf
Var' v
u -> Prefix v (Term (F v a a) v a)
-> Maybe (Prefix v (Term (F v a a) v a))
forall a. a -> Maybe a
Just (Prefix v (Term (F v a a) v a)
-> Maybe (Prefix v (Term (F v a a) v a)))
-> (Map v [v] -> Prefix v (Term (F v a a) v a))
-> Map v [v]
-> Maybe (Prefix v (Term (F v a a) v a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map v [v] -> Prefix v (Term (F v a a) v a)
forall v x. Map v [v] -> Prefix v x
Pfx (Map v [v] -> Maybe (Prefix v (Term (F v a a) v a)))
-> Map v [v] -> Maybe (Prefix v (Term (F v a a) v a))
forall a b. (a -> b) -> a -> b
$ v -> [v] -> Map v [v]
forall k a. k -> a -> Map k a
Map.singleton v
u []
Term (F v a a) v a
_ -> Maybe (Prefix v (Term (F v a a) v a))
forall a. Maybe a
Nothing
appPfx :: (Ord v) => Prefix v a -> v -> [v] -> [v]
appPfx :: forall v a. Ord v => Prefix v a -> v -> [v] -> [v]
appPfx (Pfx Map v [v]
m) v
v = ([v] -> [v]) -> ([v] -> [v] -> [v]) -> Maybe [v] -> [v] -> [v]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([v] -> [v] -> [v]
forall a b. a -> b -> a
const []) [v] -> [v] -> [v]
forall v. Eq v => [v] -> [v] -> [v]
common (Maybe [v] -> [v] -> [v]) -> Maybe [v] -> [v] -> [v]
forall a b. (a -> b) -> a -> b
$ v -> Map v [v] -> Maybe [v]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
v Map v [v]
m
dropPrefix :: (Ord v) => (Semigroup a) => v -> Int -> Term v a -> Term v a
dropPrefix :: forall v a.
(Ord v, Semigroup a) =>
v -> Int -> Term v a -> Term v a
dropPrefix v
_ Int
0 = Term v a -> Term v a
forall a. a -> a
id
dropPrefix v
v Int
n = (Term v a -> Maybe (Term v a)) -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure Term v a -> Maybe (Term v a)
rw
where
rw :: Term v a -> Maybe (Term v a)
rw (Apps' f :: Term v a
f@(Var' v
u) [Term v a]
as)
| v
v v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
u = Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> [Term v a] -> Term v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' (a -> v -> Term v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var (Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
f) v
u) (Int -> [Term v a] -> [Term v a]
forall a. Int -> [a] -> [a]
drop Int
n [Term v a]
as))
rw Term v a
_ = Maybe (Term v a)
forall a. Maybe a
Nothing
dropPrefixes ::
(Ord v) => (Semigroup a) => Map v Int -> Term v a -> Term v a
dropPrefixes :: forall v a.
(Ord v, Semigroup a) =>
Map v Int -> Term v a -> Term v a
dropPrefixes Map v Int
m = (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure Term (F v a a) v a -> Maybe (Term (F v a a) v a)
rw
where
rw :: Term (F v a a) v a -> Maybe (Term (F v a a) v a)
rw (Apps' f :: Term (F v a a) v a
f@(Var' v
u) [Term (F v a a) v a]
as)
| Just Int
n <- v -> Map v Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
u Map v Int
m =
Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a. a -> Maybe a
Just (Term (F v a a) v a -> [Term (F v a a) v a] -> Term (F v a a) v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' (a -> v -> Term (F v a a) v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var (Term (F v a a) v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term (F v a a) v a
f) v
u) (Int -> [Term (F v a a) v a] -> [Term (F v a a) v a]
forall a. Int -> [a] -> [a]
drop Int
n [Term (F v a a) v a]
as))
rw Term (F v a a) v a
_ = Maybe (Term (F v a a) v a)
forall a. Maybe a
Nothing
beta :: (Var v) => (Monoid a) => (Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
beta :: forall v a.
(Var v, Monoid a) =>
(Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
beta Term v a -> Term v a
rec (LetRecNamedTop' Bool
top (((v, Term v a) -> (v, Term v a))
-> [(v, Term v a)] -> [(v, Term v a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Term v a -> Term v a) -> (v, Term v a) -> (v, Term v a)
forall a b. (a -> b) -> (v, a) -> (v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term v a -> Term v a
rec) -> [(v, Term v a)]
vbs) (Term v a -> Term v a
rec -> Term v a
bd)) =
Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ Bool -> [(v, a, Term v a)] -> Term v a -> Term v a
forall v a vt.
(Ord v, Monoid a) =>
Bool -> [(v, a, Term' vt v a)] -> Term' vt v a -> Term' vt v a
letRec' Bool
top [(v, a, Term v a)]
lvbs Term v a
lbd
where
args :: (a, Term2 vt at ap v a) -> (a, [v])
args (a
v, LamsNamed' [v]
vs Ann' {}) = (a
v, [v]
vs)
args (a
v, LamsNamed' [v]
vs Term2 vt at ap v a
_) = (a
v, [v] -> [v]
forall a. HasCallStack => [a] -> [a]
init [v]
vs)
args (a
v, Term2 vt at ap v a
_) = (a
v, [])
Pfx Map v [v]
m0 = ((v, Term v a) -> Prefix v (Term v a))
-> [(v, Term v a)] -> Prefix v ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Term v a -> Prefix v (Term v a)
forall v a. Ord v => Term v a -> Prefix v (Term v a)
prefix (Term v a -> Prefix v (Term v a))
-> ((v, Term v a) -> Term v a)
-> (v, Term v a)
-> Prefix v (Term v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v, Term v a) -> Term v a
forall a b. (a, b) -> b
snd) [(v, Term v a)]
vbs Prefix v () -> Prefix v (Term v a) -> Prefix v (Term v a)
forall a b. Prefix v a -> Prefix v b -> Prefix v b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term v a -> Prefix v (Term v a)
forall v a. Ord v => Term v a -> Prefix v (Term v a)
prefix Term v a
bd
f :: [v] -> [v] -> Maybe [v]
f [v]
ls [v]
rs = case [v] -> [v] -> [v]
forall v. Eq v => [v] -> [v] -> [v]
common [v]
ls [v]
rs of
[] -> Maybe [v]
forall a. Maybe a
Nothing
[v]
vs -> [v] -> Maybe [v]
forall a. a -> Maybe a
Just [v]
vs
m :: Map v Int
m = ([v] -> Int) -> Map v [v] -> Map v Int
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map [v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Map v [v] -> Map v Int) -> Map v [v] -> Map v Int
forall a b. (a -> b) -> a -> b
$ ([v] -> [v] -> Maybe [v]) -> Map v [v] -> Map v [v] -> Map v [v]
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith [v] -> [v] -> Maybe [v]
forall {v}. Eq v => [v] -> [v] -> Maybe [v]
f ([(v, [v])] -> Map v [v]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(v, [v])] -> Map v [v]) -> [(v, [v])] -> Map v [v]
forall a b. (a -> b) -> a -> b
$ ((v, Term v a) -> (v, [v])) -> [(v, Term v a)] -> [(v, [v])]
forall a b. (a -> b) -> [a] -> [b]
map (v, Term v a) -> (v, [v])
forall {a} {vt} {at} {ap} {v} {a}.
(a, Term2 vt at ap v a) -> (a, [v])
args [(v, Term v a)]
vbs) Map v [v]
m0
lvbs :: [(v, a, Term v a)]
lvbs =
[(v, Term v a)]
vbs [(v, Term v a)]
-> ((v, Term v a) -> (v, a, Term v a)) -> [(v, a, Term v a)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(v
v, Term v a
b0) -> (v
v,Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
b0,) (Term v a -> (v, a, Term v a)) -> Term v a -> (v, a, Term v a)
forall a b. (a -> b) -> a -> b
$ case Term v a
b0 of
LamsNamed' [v]
vs Term v a
b
| Just Int
n <- v -> Map v Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
v Map v Int
m ->
a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns (Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
b0) (Int -> [v] -> [v]
forall a. Int -> [a] -> [a]
drop Int
n [v]
vs) (Map v Int -> Term v a -> Term v a
forall v a.
(Ord v, Semigroup a) =>
Map v Int -> Term v a -> Term v a
dropPrefixes Map v Int
m Term v a
b)
Term v a
b -> Map v Int -> Term v a -> Term v a
forall v a.
(Ord v, Semigroup a) =>
Map v Int -> Term v a -> Term v a
dropPrefixes Map v Int
m Term v a
b
lbd :: Term v a
lbd = Map v Int -> Term v a -> Term v a
forall v a.
(Ord v, Semigroup a) =>
Map v Int -> Term v a -> Term v a
dropPrefixes Map v Int
m Term v a
bd
beta Term v a -> Term v a
rec (Let1NamedTop' Bool
top v
v l :: Term v a
l@(LamsNamed' [v]
vs Term v a
bd) (Term v a -> Term v a
rec -> Term v a
e))
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ Bool -> [(v, Term v a)] -> Term v a -> Term v a
forall a v vt at ap.
(Semigroup a, Ord v) =>
Bool
-> [(v, Term2 vt at ap v a)]
-> Term2 vt at ap v a
-> Term2 vt at ap v a
let1' Bool
top [(v
v, Term v a
lamb)] (v -> Int -> Term v a -> Term v a
forall v a.
(Ord v, Semigroup a) =>
v -> Int -> Term v a -> Term v a
dropPrefix v
v Int
n Term v a
e)
| Bool
otherwise = Maybe (Term v a)
forall a. Maybe a
Nothing
where
lamb :: Term v a
lamb = a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
al (Int -> [v] -> [v]
forall a. Int -> [a] -> [a]
drop Int
n [v]
vs) (Term v a
bd)
al :: a
al = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
l
m :: Int
m
| Ann' Term v a
_ Type v a
_ <- Term v a
bd = [v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
vs
| Bool
otherwise = [v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
vs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
m (Int -> Int) -> ([v] -> Int) -> [v] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([v] -> Int) -> [v] -> Int
forall a b. (a -> b) -> a -> b
$ Prefix v (Term v a) -> v -> [v] -> [v]
forall v a. Ord v => Prefix v a -> v -> [v] -> [v]
appPfx (Term v a -> Prefix v (Term v a)
forall v a. Ord v => Term v a -> Prefix v (Term v a)
prefix Term v a
e) v
v [v]
vs
beta Term v a -> Term v a
rec (Apps' l :: Term v a
l@(LamsNamed' [v]
vs Term v a
body) [Term v a]
as)
| Int
n <- Int -> [v] -> [Term v a] -> Int
forall {a} {t} {f :: * -> *} {a}.
(Eq a, Num t) =>
t -> [a] -> [Term f a a] -> t
matchVars Int
0 [v]
vs [Term v a]
as,
Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ Term v a -> [Term v a] -> Term v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' (a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
al (Int -> [v] -> [v]
forall a. Int -> [a] -> [a]
drop Int
n [v]
vs) (Term v a -> Term v a
rec Term v a
body)) (Int -> [Term v a] -> [Term v a]
forall a. Int -> [a] -> [a]
drop Int
n [Term v a]
as)
| Bool
otherwise = Maybe (Term v a)
forall a. Maybe a
Nothing
where
al :: a
al = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
l
matchVars :: t -> [a] -> [Term f a a] -> t
matchVars !t
n (a
u : [a]
us) (Var' a
v : [Term f a a]
as) | a
u a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v = t -> [a] -> [Term f a a] -> t
matchVars (t
1 t -> t -> t
forall a. Num a => a -> a -> a
+ t
n) [a]
us [Term f a a]
as
matchVars t
n [a]
_ [Term f a a]
_ = t
n
beta Term v a -> Term v a
_ Term v a
_ = Maybe (Term v a)
forall a. Maybe a
Nothing
isStructured :: (Var v) => Term v a -> Bool
isStructured :: forall v a. Var v => Term v a -> Bool
isStructured (Var' v
_) = Bool
False
isStructured (Lam' Subst (F v a a) v a
_) = Bool
False
isStructured (Nat' Word64
_) = Bool
False
isStructured (Int' Int64
_) = Bool
False
isStructured (Float' Double
_) = Bool
False
isStructured (Text' Text
_) = Bool
False
isStructured (Char' Char
_) = Bool
False
isStructured (Constructor' ConstructorReference
_) = Bool
False
isStructured (Apps' Constructor' {} [Term (F v a a) v a]
args) = (Term (F v a a) v a -> Bool) -> [Term (F v a a) v a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured [Term (F v a a) v a]
args
isStructured (If' Term (F v a a) v a
b Term (F v a a) v a
t Term (F v a a) v a
f) =
Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term (F v a a) v a
b Bool -> Bool -> Bool
|| Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term (F v a a) v a
t Bool -> Bool -> Bool
|| Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term (F v a a) v a
f
isStructured (And' Term (F v a a) v a
l Term (F v a a) v a
r) = Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term (F v a a) v a
l Bool -> Bool -> Bool
|| Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term (F v a a) v a
r
isStructured (Or' Term (F v a a) v a
l Term (F v a a) v a
r) = Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term (F v a a) v a
l Bool -> Bool -> Bool
|| Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term (F v a a) v a
r
isStructured Term (F v a a) v a
_ = Bool
True
close :: (Var v, Monoid a) => Set v -> Term v a -> Term v a
close :: forall v a. (Var v, Monoid a) => Set v -> Term v a -> Term v a
close Set v
keep Term v a
tm = (Term v a -> Maybe (Term v a)) -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure (Set v
-> (Set v -> Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
forall v a.
(Var v, Monoid a) =>
Set v
-> (Set v -> Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
enclose Set v
keep Set v -> Term v a -> Term v a
forall v a. (Var v, Monoid a) => Set v -> Term v a -> Term v a
close) Term v a
tm
open :: (Var v, Monoid a) => Term v a -> Term v a
open :: forall v a. (Var v, Monoid a) => Term v a -> Term v a
open Term v a
x = (Term v a -> Maybe (Term v a)) -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure ((Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
forall v a.
(Var v, Monoid a) =>
(Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
beta Term v a -> Term v a
forall v a. (Var v, Monoid a) => Term v a -> Term v a
open) Term v a
x
type FloatM v a r = State (Set v, [(v, Term v a)], [(v, Term v a)]) r
freshFloat :: (Var v) => Set v -> v -> v
freshFloat :: forall v. Var v => Set v -> v -> v
freshFloat Set v
avoid (Set v -> v -> v
forall v. Var v => Set v -> v -> v
Var.freshIn Set v
avoid -> v
v0) =
case v -> Type
forall v. Var v => v -> Type
Var.typeOf v
v0 of
Var.User Text
nm
| v
v <- Type -> v
forall v. Var v => Type -> v
typed (Text -> Type
Var.User (Text -> Type) -> Text -> Type
forall a b. (a -> b) -> a -> b
$ Text
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w),
v
v v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set v
avoid ->
v
v
| Bool
otherwise ->
Set v -> v -> v
forall v. Var v => Set v -> v -> v
freshFloat (v -> Set v -> Set v
forall a. Ord a => a -> Set a -> Set a
Set.insert v
v0 Set v
avoid) v
v0
Type
_ -> v
v0
where
w :: Text
w = String -> Text
Data.Text.pack (String -> Text) -> (Word64 -> String) -> Word64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show (Word64 -> Text) -> Word64 -> Text
forall a b. (a -> b) -> a -> b
$ v -> Word64
forall v. Var v => v -> Word64
Var.freshId v
v0
groupFloater ::
(Var v, Monoid a) =>
(Term v a -> FloatM v a (Term v a)) ->
[(v, Term v a)] ->
FloatM v a (Map v v)
groupFloater :: forall v a.
(Var v, Monoid a) =>
(Term v a -> FloatM v a (Term v a))
-> [(v, Term v a)] -> FloatM v a (Map v v)
groupFloater Term v a -> FloatM v a (Term v a)
rec [(v, Term v a)]
vbs = do
Set v
cvs <- ((Set v, [(v, Term v a)], [(v, Term v a)]) -> Set v)
-> StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity (Set v)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (\(Set v
vs, [(v, Term v a)]
_, [(v, Term v a)]
_) -> Set v
vs)
let shadows :: [(v, v)]
shadows =
[ (v
v, Set v -> v -> v
forall v. Var v => Set v -> v -> v
freshFloat Set v
cvs v
v)
| (v
v, Term v a
_) <- [(v, Term v a)]
vbs,
v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member v
v Set v
cvs
]
shadowMap :: Map v v
shadowMap = [(v, v)] -> Map v v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v, v)]
shadows
rn :: v -> v
rn v
v = v -> v -> Map v v -> v
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault v
v v
v Map v v
shadowMap
shvs :: Set v
shvs = [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([v] -> Set v) -> [v] -> Set v
forall a b. (a -> b) -> a -> b
$ ((v, Term v a) -> v) -> [(v, Term v a)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (v -> v
rn (v -> v) -> ((v, Term v a) -> v) -> (v, Term v a) -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v, Term v a) -> v
forall a b. (a, b) -> a
fst) [(v, Term v a)]
vbs
((Set v, [(v, Term v a)], [(v, Term v a)])
-> (Set v, [(v, Term v a)], [(v, Term v a)]))
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((Set v, [(v, Term v a)], [(v, Term v a)])
-> (Set v, [(v, Term v a)], [(v, Term v a)]))
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity ())
-> ((Set v, [(v, Term v a)], [(v, Term v a)])
-> (Set v, [(v, Term v a)], [(v, Term v a)]))
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity ()
forall a b. (a -> b) -> a -> b
$ \(Set v
cvs, [(v, Term v a)]
ctx, [(v, Term v a)]
dcmp) -> (Set v
cvs Set v -> Set v -> Set v
forall a. Semigroup a => a -> a -> a
<> Set v
shvs, [(v, Term v a)]
ctx, [(v, Term v a)]
dcmp)
[(v, Term v a)]
fvbs <- ((v, Term v a)
-> StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity (v, Term v a))
-> [(v, Term v a)]
-> StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity [(v, Term v a)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\(v
v, Term v a
b) -> (,) (v -> v
rn v
v) (Term v a -> (v, Term v a))
-> FloatM v a (Term v a)
-> StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity (v, Term v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a -> FloatM v a (Term v a)
rec' (Map v v -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
Map v v -> Term f v a -> Term f v a
ABT.renames Map v v
shadowMap Term v a
b)) [(v, Term v a)]
vbs
let dvbs :: [(v, Term v a)]
dvbs = ((v, Term v a) -> (v, Term v a))
-> [(v, Term v a)] -> [(v, Term v a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(v
v, Term v a
b) -> (v -> v
rn v
v, Term v a -> Term v a
forall v a. Var v => Term v a -> Term v a
deannotate Term v a
b)) [(v, Term v a)]
vbs
((Set v, [(v, Term v a)], [(v, Term v a)])
-> (Set v, [(v, Term v a)], [(v, Term v a)]))
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((Set v, [(v, Term v a)], [(v, Term v a)])
-> (Set v, [(v, Term v a)], [(v, Term v a)]))
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity ())
-> ((Set v, [(v, Term v a)], [(v, Term v a)])
-> (Set v, [(v, Term v a)], [(v, Term v a)]))
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity ()
forall a b. (a -> b) -> a -> b
$ \(Set v
vs, [(v, Term v a)]
ctx, [(v, Term v a)]
dcmp) -> (Set v
vs, [(v, Term v a)]
ctx [(v, Term v a)] -> [(v, Term v a)] -> [(v, Term v a)]
forall a. [a] -> [a] -> [a]
++ [(v, Term v a)]
fvbs, [(v, Term v a)]
dcmp [(v, Term v a)] -> [(v, Term v a)] -> [(v, Term v a)]
forall a. Semigroup a => a -> a -> a
<> [(v, Term v a)]
dvbs)
pure Map v v
shadowMap
where
rec' :: Term v a -> FloatM v a (Term v a)
rec' Term v a
b
| Just ([v]
vs0, Maybe (Type v a)
mty, [v]
vs1, Term v a
bd) <- Term v a -> Maybe ([v], Maybe (Type v a), [v], Term v a)
forall v a.
Term v a -> Maybe ([v], Maybe (Type v a), [v], Term v a)
unLamsAnnot Term v a
b =
a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
vs0 (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term v a -> Term v a)
-> (Type v a -> Term v a -> Term v a)
-> Maybe (Type v a)
-> Term v a
-> Term v a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Term v a -> Term v a
forall a. a -> a
id ((Term v a -> Type v a -> Term v a)
-> Type v a -> Term v a -> Term v a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Term v a -> Type v a -> Term v a)
-> Type v a -> Term v a -> Term v a)
-> (Term v a -> Type v a -> Term v a)
-> Type v a
-> Term v a
-> Term v a
forall a b. (a -> b) -> a -> b
$ a -> Term v a -> Type v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Type vt at -> Term2 vt at ap v a
ann a
a) Maybe (Type v a)
mty (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
vs1 (Term v a -> Term v a)
-> FloatM v a (Term v a) -> FloatM v a (Term v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a -> FloatM v a (Term v a)
rec Term v a
bd
where
a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
b
rec' Term v a
b = Term v a -> FloatM v a (Term v a)
rec Term v a
b
letFloater ::
(Var v, Monoid a) =>
(Term v a -> FloatM v a (Term v a)) ->
[(v, Term v a)] ->
Term v a ->
FloatM v a (Term v a)
letFloater :: forall v a.
(Var v, Monoid a) =>
(Term v a -> FloatM v a (Term v a))
-> [(v, Term v a)] -> Term v a -> FloatM v a (Term v a)
letFloater Term v a -> FloatM v a (Term v a)
rec [(v, Term v a)]
vbs Term v a
e = do
Map v v
shadowMap <- (Term v a -> FloatM v a (Term v a))
-> [(v, Term v a)] -> FloatM v a (Map v v)
forall v a.
(Var v, Monoid a) =>
(Term v a -> FloatM v a (Term v a))
-> [(v, Term v a)] -> FloatM v a (Map v v)
groupFloater Term v a -> FloatM v a (Term v a)
rec [(v, Term v a)]
vbs
pure $ Map v v -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
Map v v -> Term f v a -> Term f v a
ABT.renames Map v v
shadowMap Term v a
e
lamFloater ::
(Var v, Monoid a) =>
Bool ->
Term v a ->
Maybe v ->
a ->
[v] ->
Term v a ->
FloatM v a v
lamFloater :: forall v a.
(Var v, Monoid a) =>
Bool -> Term v a -> Maybe v -> a -> [v] -> Term v a -> FloatM v a v
lamFloater Bool
closed Term2 v a a v a
tm Maybe v
mv a
a [v]
vs Term2 v a a v a
bd =
((Set v, [(v, Term2 v a a v a)], [(v, Term2 v a a v a)])
-> (v, (Set v, [(v, Term2 v a a v a)], [(v, Term2 v a a v a)])))
-> StateT
(Set v, [(v, Term2 v a a v a)], [(v, Term2 v a a v a)]) Identity v
forall a.
((Set v, [(v, Term2 v a a v a)], [(v, Term2 v a a v a)])
-> (a, (Set v, [(v, Term2 v a a v a)], [(v, Term2 v a a v a)])))
-> StateT
(Set v, [(v, Term2 v a a v a)], [(v, Term2 v a a v a)]) Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (((Set v, [(v, Term2 v a a v a)], [(v, Term2 v a a v a)])
-> (v, (Set v, [(v, Term2 v a a v a)], [(v, Term2 v a a v a)])))
-> StateT
(Set v, [(v, Term2 v a a v a)], [(v, Term2 v a a v a)]) Identity v)
-> ((Set v, [(v, Term2 v a a v a)], [(v, Term2 v a a v a)])
-> (v, (Set v, [(v, Term2 v a a v a)], [(v, Term2 v a a v a)])))
-> StateT
(Set v, [(v, Term2 v a a v a)], [(v, Term2 v a a v a)]) Identity v
forall a b. (a -> b) -> a -> b
$ \trip :: (Set v, [(v, Term2 v a a v a)], [(v, Term2 v a a v a)])
trip@(Set v
cvs, [(v, Term2 v a a v a)]
ctx, [(v, Term2 v a a v a)]
dcmp) -> case ((v, Term2 v a a v a) -> Bool)
-> [(v, Term2 v a a v a)] -> Maybe (v, Term2 v a a v a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (v, Term2 v a a v a) -> Bool
p [(v, Term2 v a a v a)]
ctx of
Just (v
v, Term2 v a a v a
_) -> (v
v, (Set v, [(v, Term2 v a a v a)], [(v, Term2 v a a v a)])
trip)
Maybe (v, Term2 v a a v a)
Nothing ->
let v :: v
v = Set v -> v -> v
forall v. Var v => Set v -> v -> v
ABT.freshIn Set v
cvs (v -> v) -> v -> v
forall a b. (a -> b) -> a -> b
$ v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe (Type -> v
forall v. Var v => Type -> v
typed Type
Var.Float) Maybe v
mv
in ( v
v,
( v -> Set v -> Set v
forall a. Ord a => a -> Set a -> Set a
Set.insert v
v Set v
cvs,
[(v, Term2 v a a v a)]
ctx [(v, Term2 v a a v a)]
-> [(v, Term2 v a a v a)] -> [(v, Term2 v a a v a)]
forall a. Semigroup a => a -> a -> a
<> [(v
v, a -> [v] -> Term2 v a a v a -> Term2 v a a v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
vs Term2 v a a v a
bd)],
Bool
-> v
-> Term2 v a a v a
-> [(v, Term2 v a a v a)]
-> [(v, Term2 v a a v a)]
forall v a.
Bool -> v -> Term v a -> [(v, Term v a)] -> [(v, Term v a)]
floatDecomp Bool
closed v
v Term2 v a a v a
tm [(v, Term2 v a a v a)]
dcmp
)
)
where
tgt :: Term0' v v
tgt = Term2 v a a v a -> Term0' v v
forall vt at ap v a. Ord v => Term2 vt at ap v a -> Term0' vt v
unannotate (a -> [v] -> Term2 v a a v a -> Term2 v a a v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
vs Term2 v a a v a
bd)
p :: (v, Term2 v a a v a) -> Bool
p (v
_, Term2 v a a v a
flam) = Term2 v a a v a -> Term0' v v
forall vt at ap v a. Ord v => Term2 vt at ap v a -> Term0' vt v
unannotate Term2 v a a v a
flam Term0' v v -> Term0' v v -> Bool
forall a. Eq a => a -> a -> Bool
== Term0' v v
tgt
floatDecomp ::
Bool -> v -> Term v a -> [(v, Term v a)] -> [(v, Term v a)]
floatDecomp :: forall v a.
Bool -> v -> Term v a -> [(v, Term v a)] -> [(v, Term v a)]
floatDecomp Bool
True v
v Term v a
b [(v, Term v a)]
dcmp = (v
v, Term v a
b) (v, Term v a) -> [(v, Term v a)] -> [(v, Term v a)]
forall a. a -> [a] -> [a]
: [(v, Term v a)]
dcmp
floatDecomp Bool
False v
_ Term v a
_ [(v, Term v a)]
dcmp = [(v, Term v a)]
dcmp
floater ::
(Var v, Monoid a) =>
Bool ->
(Term v a -> FloatM v a (Term v a)) ->
Term v a ->
Maybe (FloatM v a (Term v a))
floater :: forall v a.
(Var v, Monoid a) =>
Bool
-> (Term v a -> FloatM v a (Term v a))
-> Term v a
-> Maybe (FloatM v a (Term v a))
floater Bool
top Term v a -> FloatM v a (Term v a)
rec tm0 :: Term v a
tm0@(Ann' Term v a
tm Type v a
ty) =
((FloatM v a (Term v a) -> FloatM v a (Term v a))
-> Maybe (FloatM v a (Term v a)) -> Maybe (FloatM v a (Term v a))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FloatM v a (Term v a) -> FloatM v a (Term v a))
-> Maybe (FloatM v a (Term v a)) -> Maybe (FloatM v a (Term v a)))
-> ((Term v a -> Term v a)
-> FloatM v a (Term v a) -> FloatM v a (Term v a))
-> (Term v a -> Term v a)
-> Maybe (FloatM v a (Term v a))
-> Maybe (FloatM v a (Term v a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term v a -> Term v a)
-> FloatM v a (Term v a) -> FloatM v a (Term v a)
forall a b.
(a -> b)
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity a
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (\Term v a
tm -> a -> Term v a -> Type v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Type vt at -> Term2 vt at ap v a
ann a
a Term v a
tm Type v a
ty) (Bool
-> (Term v a -> FloatM v a (Term v a))
-> Term v a
-> Maybe (FloatM v a (Term v a))
forall v a.
(Var v, Monoid a) =>
Bool
-> (Term v a -> FloatM v a (Term v a))
-> Term v a
-> Maybe (FloatM v a (Term v a))
floater Bool
top Term v a -> FloatM v a (Term v a)
rec Term v a
tm)
where
a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
tm0
floater Bool
top Term v a -> FloatM v a (Term v a)
rec (LetRecNamed' [(v, Term v a)]
vbs Term v a
e) =
FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a. a -> Maybe a
Just (FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a)))
-> FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a b. (a -> b) -> a -> b
$
(Term v a -> FloatM v a (Term v a))
-> [(v, Term v a)] -> Term v a -> FloatM v a (Term v a)
forall v a.
(Var v, Monoid a) =>
(Term v a -> FloatM v a (Term v a))
-> [(v, Term v a)] -> Term v a -> FloatM v a (Term v a)
letFloater Term v a -> FloatM v a (Term v a)
rec [(v, Term v a)]
vbs Term v a
e FloatM v a (Term v a)
-> (Term v a -> FloatM v a (Term v a)) -> FloatM v a (Term v a)
forall a b.
StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity a
-> (a
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity b)
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
lm :: Term v a
lm@(LamsNamed' [v]
vs Term v a
bd) | Bool
top -> a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
vs (Term v a -> Term v a)
-> FloatM v a (Term v a) -> FloatM v a (Term v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a -> FloatM v a (Term v a)
rec Term v a
bd
where
a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
lm
Term v a
tm -> Term v a -> FloatM v a (Term v a)
rec Term v a
tm
floater Bool
_ Term v a -> FloatM v a (Term v a)
rec (Let1Named' v
v Term v a
b Term v a
e)
| Just ([v]
vs0, Maybe (Type v a)
_, [v]
vs1, Term v a
bd) <- Term v a -> Maybe ([v], Maybe (Type v a), [v], Term v a)
forall v a.
Term v a -> Maybe ([v], Maybe (Type v a), [v], Term v a)
unLamsAnnot Term v a
b =
FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a. a -> Maybe a
Just (FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a)))
-> FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a b. (a -> b) -> a -> b
$
Term v a -> FloatM v a (Term v a)
rec Term v a
bd
FloatM v a (Term v a)
-> (Term v a
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity v)
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity v
forall a b.
StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity a
-> (a
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity b)
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool
-> Term v a
-> Maybe v
-> a
-> [v]
-> Term v a
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity v
forall v a.
(Var v, Monoid a) =>
Bool -> Term v a -> Maybe v -> a -> [v] -> Term v a -> FloatM v a v
lamFloater Bool
True Term v a
b (v -> Maybe v
forall a. a -> Maybe a
Just v
v) a
a ([v]
vs0 [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
++ [v]
vs1)
StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity v
-> (v -> FloatM v a (Term v a)) -> FloatM v a (Term v a)
forall a b.
StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity a
-> (a
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity b)
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \v
lv -> Term v a -> FloatM v a (Term v a)
rec (Term v a -> FloatM v a (Term v a))
-> Term v a -> FloatM v a (Term v a)
forall a b. (a -> b) -> a -> b
$ Map v v -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
Map v v -> Term f v a -> Term f v a
ABT.renames (v -> v -> Map v v
forall k a. k -> a -> Map k a
Map.singleton v
v v
lv) Term v a
e
where
a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
b
floater Bool
top Term v a -> FloatM v a (Term v a)
rec tm :: Term v a
tm@(LamsNamed' [v]
vs Term v a
bd)
| Bool
top = FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a. a -> Maybe a
Just (FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a)))
-> FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a b. (a -> b) -> a -> b
$ a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
vs (Term v a -> Term v a)
-> FloatM v a (Term v a) -> FloatM v a (Term v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a -> FloatM v a (Term v a)
rec Term v a
bd
| Bool
otherwise = FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a. a -> Maybe a
Just (FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a)))
-> FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a b. (a -> b) -> a -> b
$ do
Term v a
bd <- Term v a -> FloatM v a (Term v a)
rec Term v a
bd
v
lv <- Bool
-> Term v a
-> Maybe v
-> a
-> [v]
-> Term v a
-> StateT (Set v, [(v, Term v a)], [(v, Term v a)]) Identity v
forall v a.
(Var v, Monoid a) =>
Bool -> Term v a -> Maybe v -> a -> [v] -> Term v a -> FloatM v a v
lamFloater Bool
True Term v a
tm Maybe v
forall a. Maybe a
Nothing a
a [v]
vs Term v a
bd
pure $ a -> v -> Term v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
a v
lv
where
a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
tm
floater Bool
_ Term v a -> FloatM v a (Term v a)
_ Term v a
_ = Maybe (FloatM v a (Term v a))
forall a. Maybe a
Nothing
postFloat ::
(Var v) =>
(Monoid a) =>
Map v Reference ->
(Set v, [(v, Term v a)], [(v, Term v a)]) ->
( [(v, Term v a)],
[(v, Id)],
[(Reference, Term v a)],
[(Reference, Term v a)]
)
postFloat :: forall v a.
(Var v, Monoid a) =>
Map v Reference
-> (Set v, [(v, Term v a)], [(v, Term v a)])
-> ([(v, Term v a)], [(v, Id)], [(Reference, Term v a)],
[(Reference, Term v a)])
postFloat Map v Reference
orig (Set v
_, [(v, Term2 v a a v a)]
bs, [(v, Term2 v a a v a)]
dcmp) =
( [(v, Term2 v a a v a)]
subs,
[(v, Id)]
subvs,
((Id, Term2 v a a v a) -> (Reference, Term2 v a a v a))
-> [(Id, Term2 v a a v a)] -> [(Reference, Term2 v a a v a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Id -> Reference)
-> (Id, Term2 v a a v a) -> (Reference, Term2 v a a v a)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Id -> Reference
forall h t. Id' h -> Reference' t h
DerivedId) [(Id, Term2 v a a v a)]
tops,
[(v, Term2 v a a v a)]
dcmp [(v, Term2 v a a v a)]
-> ((v, Term2 v a a v a) -> [(Reference, Term2 v a a v a)])
-> [(Reference, Term2 v a a v a)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(v
v, Term2 v a a v a
tm) ->
let stm :: Term2 v a a v a
stm = Term2 v a a v a -> Term2 v a a v a
forall v a. (Var v, Monoid a) => Term v a -> Term v a
open (Term2 v a a v a -> Term2 v a a v a)
-> Term2 v a a v a -> Term2 v a a v a
forall a b. (a -> b) -> a -> b
$ [(v, Term2 v a a v a)] -> Term2 v a a v a -> Term2 v a a v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v a)] -> Term f v a -> Term f v a
ABT.substs [(v, Term2 v a a v a)]
dsubs Term2 v a a v a
tm
in (Map v Reference
subm Map v Reference -> v -> Reference
forall k a. Ord k => Map k a -> k -> a
Map.! v
v, Term2 v a a v a
stm) (Reference, Term2 v a a v a)
-> [(Reference, Term2 v a a v a)] -> [(Reference, Term2 v a a v a)]
forall a. a -> [a] -> [a]
: [(Reference
r, Term2 v a a v a
stm) | Just Reference
r <- [v -> Map v Reference -> Maybe Reference
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
v Map v Reference
orig]]
)
where
m :: Map v (Id, Term2 v a a v a)
m =
((Id, Term2 v a a v a) -> (Id, Term2 v a a v a))
-> Map v (Id, Term2 v a a v a) -> Map v (Id, Term2 v a a v a)
forall a b. (a -> b) -> Map v a -> Map v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Term2 v a a v a -> Term2 v a a v a)
-> (Id, Term2 v a a v a) -> (Id, Term2 v a a v a)
forall a b. (a -> b) -> (Id, a) -> (Id, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term2 v a a v a -> Term2 v a a v a
forall v a. Var v => Term v a -> Term v a
deannotate)
(Map v (Id, Term2 v a a v a) -> Map v (Id, Term2 v a a v a))
-> ([(v, Term2 v a a v a)] -> Map v (Id, Term2 v a a v a))
-> [(v, Term2 v a a v a)]
-> Map v (Id, Term2 v a a v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map v (Term2 v a a v a) -> Map v (Id, Term2 v a a v a)
forall v a. Var v => Map v (Term v a) -> Map v (Id, Term v a)
hashTermComponentsWithoutTypes
(Map v (Term2 v a a v a) -> Map v (Id, Term2 v a a v a))
-> ([(v, Term2 v a a v a)] -> Map v (Term2 v a a v a))
-> [(v, Term2 v a a v a)]
-> Map v (Id, Term2 v a a v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(v, Term2 v a a v a)] -> Map v (Term2 v a a v a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
([(v, Term2 v a a v a)] -> Map v (Id, Term2 v a a v a))
-> [(v, Term2 v a a v a)] -> Map v (Id, Term2 v a a v a)
forall a b. (a -> b) -> a -> b
$ [(v, Term2 v a a v a)]
bs
trips :: [(v, (Id, Term2 v a a v a))]
trips = Map v (Id, Term2 v a a v a) -> [(v, (Id, Term2 v a a v a))]
forall k a. Map k a -> [(k, a)]
Map.toList Map v (Id, Term2 v a a v a)
m
f :: (a, (Id, Term f v a))
-> ((a, Id), (a, Term2 vt at ap v a), (Id, Term f v a))
f (a
v, (Id
id, Term f v a
tm)) = ((a
v, Id
id), (a
v, Term2 vt at ap v a
idtm), (Id
id, Term f v a
tm))
where
idtm :: Term2 vt at ap v a
idtm = a -> Reference -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Reference -> Term2 vt at ap v a
ref (Term f v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term f v a
tm) (Id -> Reference
forall h t. Id' h -> Reference' t h
DerivedId Id
id)
([(v, Id)]
subvs, [(v, Term2 v a a v a)]
subs, [(Id, Term2 v a a v a)]
tops) = [((v, Id), (v, Term2 v a a v a), (Id, Term2 v a a v a))]
-> ([(v, Id)], [(v, Term2 v a a v a)], [(Id, Term2 v a a v a)])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([((v, Id), (v, Term2 v a a v a), (Id, Term2 v a a v a))]
-> ([(v, Id)], [(v, Term2 v a a v a)], [(Id, Term2 v a a v a)]))
-> [((v, Id), (v, Term2 v a a v a), (Id, Term2 v a a v a))]
-> ([(v, Id)], [(v, Term2 v a a v a)], [(Id, Term2 v a a v a)])
forall a b. (a -> b) -> a -> b
$ ((v, (Id, Term2 v a a v a))
-> ((v, Id), (v, Term2 v a a v a), (Id, Term2 v a a v a)))
-> [(v, (Id, Term2 v a a v a))]
-> [((v, Id), (v, Term2 v a a v a), (Id, Term2 v a a v a))]
forall a b. (a -> b) -> [a] -> [b]
map (v, (Id, Term2 v a a v a))
-> ((v, Id), (v, Term2 v a a v a), (Id, Term2 v a a v a))
forall {v} {a} {f :: * -> *} {v} {a} {vt} {at} {ap}.
Ord v =>
(a, (Id, Term f v a))
-> ((a, Id), (a, Term2 vt at ap v a), (Id, Term f v a))
f [(v, (Id, Term2 v a a v a))]
trips
subm :: Map v Reference
subm = (Id -> Reference) -> Map v Id -> Map v Reference
forall a b. (a -> b) -> Map v a -> Map v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> Reference
forall h t. Id' h -> Reference' t h
DerivedId ([(v, Id)] -> Map v Id
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v, Id)]
subvs)
dsubs :: [(v, Term2 v a a v a)]
dsubs = Map v (Term2 v a a v a) -> [(v, Term2 v a a v a)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map v (Term2 v a a v a) -> [(v, Term2 v a a v a)])
-> Map v (Term2 v a a v a) -> [(v, Term2 v a a v a)]
forall a b. (a -> b) -> a -> b
$ (Reference -> Term2 v a a v a)
-> Map v Reference -> Map v (Term2 v a a v a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (a -> Reference -> Term2 v a a v a
forall v a vt at ap. Ord v => a -> Reference -> Term2 vt at ap v a
ref a
forall a. Monoid a => a
mempty) Map v Reference
orig Map v (Term2 v a a v a)
-> Map v (Term2 v a a v a) -> Map v (Term2 v a a v a)
forall a. Semigroup a => a -> a -> a
<> [(v, Term2 v a a v a)] -> Map v (Term2 v a a v a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v, Term2 v a a v a)]
subs
float ::
(Var v) =>
(Monoid a) =>
Map v Reference ->
Term v a ->
(Term v a, Map Reference Reference, [(Reference, Term v a)], [(Reference, Term v a)])
float :: forall v a.
(Var v, Monoid a) =>
Map v Reference
-> Term v a
-> (Term v a, Map Reference Reference, [(Reference, Term v a)],
[(Reference, Term v a)])
float Map v Reference
orig Term v a
tm = case State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a)
-> (Set v, [(v, Term v a)], [(v, Term v a)])
-> (Term v a, (Set v, [(v, Term v a)], [(v, Term v a)]))
forall s a. State s a -> s -> (a, s)
runState State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a)
go0 (Set v
forall a. Set a
Set.empty, [], []) of
(Term v a
bd, (Set v, [(v, Term v a)], [(v, Term v a)])
st) -> case Map v Reference
-> (Set v, [(v, Term v a)], [(v, Term v a)])
-> ([(v, Term v a)], [(v, Id)], [(Reference, Term v a)],
[(Reference, Term v a)])
forall v a.
(Var v, Monoid a) =>
Map v Reference
-> (Set v, [(v, Term v a)], [(v, Term v a)])
-> ([(v, Term v a)], [(v, Id)], [(Reference, Term v a)],
[(Reference, Term v a)])
postFloat Map v Reference
orig (Set v, [(v, Term v a)], [(v, Term v a)])
st of
([(v, Term v a)]
subs, [(v, Id)]
subvs, [(Reference, Term v a)]
tops, [(Reference, Term v a)]
dcmp) ->
( Bool -> [(v, a, Term v a)] -> Term v a -> Term v a
forall v a vt.
(Ord v, Monoid a) =>
Bool -> [(v, a, Term' vt v a)] -> Term' vt v a -> Term' vt v a
letRec' Bool
True [] (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(v, Term v a)] -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v a)] -> Term f v a -> Term f v a
ABT.substs [(v, Term v a)]
subs (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v a -> Term v a
forall v a. Var v => Term v a -> Term v a
deannotate (Term v a -> Term v a) -> Term v a -> Term v a
forall a b. (a -> b) -> a -> b
$ Term v a
bd,
[(Reference, Reference)] -> Map Reference Reference
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, Reference)] -> Map Reference Reference)
-> ([(v, Id)] -> [(Reference, Reference)])
-> [(v, Id)]
-> Map Reference Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v, Id) -> Maybe (Reference, Reference))
-> [(v, Id)] -> [(Reference, Reference)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (v, Id) -> Maybe (Reference, Reference)
f ([(v, Id)] -> Map Reference Reference)
-> [(v, Id)] -> Map Reference Reference
forall a b. (a -> b) -> a -> b
$ [(v, Id)]
subvs,
[(Reference, Term v a)]
tops,
[(Reference, Term v a)]
dcmp
)
where
f :: (v, Id) -> Maybe (Reference, Reference)
f (v
v, Id
i) = (,Id -> Reference
forall h t. Id' h -> Reference' t h
DerivedId Id
i) (Reference -> (Reference, Reference))
-> Maybe Reference -> Maybe (Reference, Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v -> Map v Reference -> Maybe Reference
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
v Map v Reference
orig
go0 :: State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a)
go0 = State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a)
-> Maybe
(State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a))
-> State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a)
forall a. a -> Maybe a -> a
fromMaybe (Term v a
-> State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a)
go Term v a
tm) (Bool
-> (Term v a
-> State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a))
-> Term v a
-> Maybe
(State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a))
forall v a.
(Var v, Monoid a) =>
Bool
-> (Term v a -> FloatM v a (Term v a))
-> Term v a
-> Maybe (FloatM v a (Term v a))
floater Bool
True Term v a
-> State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a)
go Term v a
tm)
go :: Term v a
-> State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a)
go = (Term v a
-> Maybe
(State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a)))
-> Term v a
-> State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a)
forall (f :: * -> *) (g :: * -> *) v a.
(Traversable f, Applicative g, Ord v) =>
(Term f v a -> Maybe (g (Term f v a)))
-> Term f v a -> g (Term f v a)
ABT.visit ((Term v a
-> Maybe
(State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a)))
-> Term v a
-> State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a))
-> (Term v a
-> Maybe
(State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a)))
-> Term v a
-> State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a)
forall a b. (a -> b) -> a -> b
$ Bool
-> (Term v a
-> State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a))
-> Term v a
-> Maybe
(State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a))
forall v a.
(Var v, Monoid a) =>
Bool
-> (Term v a -> FloatM v a (Term v a))
-> Term v a
-> Maybe (FloatM v a (Term v a))
floater Bool
False Term v a
-> State (Set v, [(v, Term v a)], [(v, Term v a)]) (Term v a)
go
floatGroup ::
(Var v) =>
(Monoid a) =>
Map v Reference ->
[(v, Term v a)] ->
([(v, Id)], [(Reference, Term v a)], [(Reference, Term v a)])
floatGroup :: forall v a.
(Var v, Monoid a) =>
Map v Reference
-> [(v, Term v a)]
-> ([(v, Id)], [(Reference, Term v a)], [(Reference, Term v a)])
floatGroup Map v Reference
orig [(v, Term v a)]
grp = case State (Set v, [(v, Term v a)], [(v, Term v a)]) (Map v v)
-> (Set v, [(v, Term v a)], [(v, Term v a)])
-> (Map v v, (Set v, [(v, Term v a)], [(v, Term v a)]))
forall s a. State s a -> s -> (a, s)
runState State (Set v, [(v, Term v a)], [(v, Term v a)]) (Map v v)
go0 (Set v
forall a. Set a
Set.empty, [], []) of
(Map v v
_, (Set v, [(v, Term v a)], [(v, Term v a)])
st) -> case Map v Reference
-> (Set v, [(v, Term v a)], [(v, Term v a)])
-> ([(v, Term v a)], [(v, Id)], [(Reference, Term v a)],
[(Reference, Term v a)])
forall v a.
(Var v, Monoid a) =>
Map v Reference
-> (Set v, [(v, Term v a)], [(v, Term v a)])
-> ([(v, Term v a)], [(v, Id)], [(Reference, Term v a)],
[(Reference, Term v a)])
postFloat Map v Reference
orig (Set v, [(v, Term v a)], [(v, Term v a)])
st of
([(v, Term v a)]
_, [(v, Id)]
subvs, [(Reference, Term v a)]
tops, [(Reference, Term v a)]
dcmp) -> ([(v, Id)]
subvs, [(Reference, Term v a)]
tops, [(Reference, Term v a)]
dcmp)
where
go :: Term v a
-> StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity (Term v a)
go = (Term v a
-> Maybe
(StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity (Term v a)))
-> Term v a
-> StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity (Term v a)
forall (f :: * -> *) (g :: * -> *) v a.
(Traversable f, Applicative g, Ord v) =>
(Term f v a -> Maybe (g (Term f v a)))
-> Term f v a -> g (Term f v a)
ABT.visit ((Term v a
-> Maybe
(StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity (Term v a)))
-> Term v a
-> StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity (Term v a))
-> (Term v a
-> Maybe
(StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity (Term v a)))
-> Term v a
-> StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity (Term v a)
forall a b. (a -> b) -> a -> b
$ Bool
-> (Term v a
-> StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity (Term v a))
-> Term v a
-> Maybe
(StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity (Term v a))
forall v a.
(Var v, Monoid a) =>
Bool
-> (Term v a -> FloatM v a (Term v a))
-> Term v a
-> Maybe (FloatM v a (Term v a))
floater Bool
False Term v a
-> StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity (Term v a)
go
go0 :: State (Set v, [(v, Term v a)], [(v, Term v a)]) (Map v v)
go0 = (Term v a
-> StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity (Term v a))
-> [(v, Term v a)]
-> State (Set v, [(v, Term v a)], [(v, Term v a)]) (Map v v)
forall v a.
(Var v, Monoid a) =>
(Term v a -> FloatM v a (Term v a))
-> [(v, Term v a)] -> FloatM v a (Map v v)
groupFloater Term v a
-> StateT
(Set v, [(v, Term v a)], [(v, Term v a)]) Identity (Term v a)
go [(v, Term v a)]
grp
unAnn :: Term v a -> Term v a
unAnn :: forall v a. Term v a -> Term v a
unAnn (Ann' Term (F v a a) v a
tm Type v a
_) = Term (F v a a) v a
tm
unAnn Term (F v a a) v a
tm = Term (F v a a) v a
tm
unLamsAnnot :: Term v a -> Maybe ([v], Maybe (Ty.Type v a), [v], Term v a)
unLamsAnnot :: forall v a.
Term v a -> Maybe ([v], Maybe (Type v a), [v], Term v a)
unLamsAnnot Term v a
tm0
| [v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
vs0, [v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
vs1 = Maybe ([v], Maybe (Type v a), [v], Term v a)
forall a. Maybe a
Nothing
| Bool
otherwise = ([v], Maybe (Type v a), [v], Term v a)
-> Maybe ([v], Maybe (Type v a), [v], Term v a)
forall a. a -> Maybe a
Just ([v]
vs0, Maybe (Type v a)
mty, [v]
vs1, Term v a
bd)
where
([v]
vs0, Term v a
bd0)
| LamsNamed' [v]
vs Term v a
bd <- Term v a
tm0 = ([v]
vs, Term v a
bd)
| Bool
otherwise = ([], Term v a
tm0)
(Maybe (Type v a)
mty, Term v a
bd1)
| Ann' Term v a
bd Type v a
ty <- Term v a
bd0 = (Type v a -> Maybe (Type v a)
forall a. a -> Maybe a
Just Type v a
ty, Term v a
bd)
| Bool
otherwise = (Maybe (Type v a)
forall a. Maybe a
Nothing, Term v a
bd0)
([v]
vs1, Term v a
bd)
| LamsNamed' [v]
vs Term v a
bd <- Term v a
bd1 = ([v]
vs, Term v a
bd)
| Bool
otherwise = ([], Term v a
bd1)
deannotate :: (Var v) => Term v a -> Term v a
deannotate :: forall v a. Var v => Term v a -> Term v a
deannotate = (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure ((Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a)
-> (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a
-> Term (F v a a) v a
forall a b. (a -> b) -> a -> b
$ \case
Ann' Term (F v a a) v a
c Type v a
_ -> Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a. a -> Maybe a
Just (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a b. (a -> b) -> a -> b
$ Term (F v a a) v a -> Term (F v a a) v a
forall v a. Var v => Term v a -> Term v a
deannotate Term (F v a a) v a
c
Term (F v a a) v a
_ -> Maybe (Term (F v a a) v a)
forall a. Maybe a
Nothing
lamLift ::
(Var v) =>
(Monoid a) =>
Map v Reference ->
Term v a ->
(Term v a, Map Reference Reference, [(Reference, Term v a)], [(Reference, Term v a)])
lamLift :: forall v a.
(Var v, Monoid a) =>
Map v Reference
-> Term v a
-> (Term v a, Map Reference Reference, [(Reference, Term v a)],
[(Reference, Term v a)])
lamLift Map v Reference
orig = Map v Reference
-> Term v a
-> (Term v a, Map Reference Reference, [(Reference, Term v a)],
[(Reference, Term v a)])
forall v a.
(Var v, Monoid a) =>
Map v Reference
-> Term v a
-> (Term v a, Map Reference Reference, [(Reference, Term v a)],
[(Reference, Term v a)])
float Map v Reference
orig (Term v a
-> (Term v a, Map Reference Reference, [(Reference, Term v a)],
[(Reference, Term v a)]))
-> (Term v a -> Term v a)
-> Term v a
-> (Term v a, Map Reference Reference, [(Reference, Term v a)],
[(Reference, Term v a)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set v -> Term v a -> Term v a
forall v a. (Var v, Monoid a) => Set v -> Term v a -> Term v a
close Set v
forall a. Set a
Set.empty
lamLiftGroup ::
(Var v) =>
(Monoid a) =>
Map v Reference ->
[(v, Term v a)] ->
([(v, Id)], [(Reference, Term v a)], [(Reference, Term v a)])
lamLiftGroup :: forall v a.
(Var v, Monoid a) =>
Map v Reference
-> [(v, Term v a)]
-> ([(v, Id)], [(Reference, Term v a)], [(Reference, Term v a)])
lamLiftGroup Map v Reference
orig [(v, Term v a)]
gr = Map v Reference
-> [(v, Term v a)]
-> ([(v, Id)], [(Reference, Term v a)], [(Reference, Term v a)])
forall v a.
(Var v, Monoid a) =>
Map v Reference
-> [(v, Term v a)]
-> ([(v, Id)], [(Reference, Term v a)], [(Reference, Term v a)])
floatGroup Map v Reference
orig ([(v, Term v a)]
-> ([(v, Id)], [(Reference, Term v a)], [(Reference, Term v a)]))
-> ([(v, Term v a)] -> [(v, Term v a)])
-> [(v, Term v a)]
-> ([(v, Id)], [(Reference, Term v a)], [(Reference, Term v a)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((v, Term v a) -> (v, Term v a))
-> [(v, Term v a)] -> [(v, Term v a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((v, Term v a) -> (v, Term v a))
-> [(v, Term v a)] -> [(v, Term v a)])
-> ((Term v a -> Term v a) -> (v, Term v a) -> (v, Term v a))
-> (Term v a -> Term v a)
-> [(v, Term v a)]
-> [(v, Term v a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term v a -> Term v a) -> (v, Term v a) -> (v, Term v a)
forall a b. (a -> b) -> (v, a) -> (v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Set v -> Term v a -> Term v a
forall v a. (Var v, Monoid a) => Set v -> Term v a -> Term v a
close Set v
keep) ([(v, Term v a)]
-> ([(v, Id)], [(Reference, Term v a)], [(Reference, Term v a)]))
-> [(v, Term v a)]
-> ([(v, Id)], [(Reference, Term v a)], [(Reference, Term v a)])
forall a b. (a -> b) -> a -> b
$ [(v, Term v a)]
gr
where
keep :: Set v
keep = [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([v] -> Set v) -> [v] -> Set v
forall a b. (a -> b) -> a -> b
$ ((v, Term v a) -> v) -> [(v, Term v a)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (v, Term v a) -> v
forall a b. (a, b) -> a
fst [(v, Term v a)]
gr
saturate ::
(Var v, Monoid a) =>
Map ConstructorReference Int ->
Term v a ->
Term v a
saturate :: forall v a.
(Var v, Monoid a) =>
Map ConstructorReference Int -> Term v a -> Term v a
saturate Map ConstructorReference Int
dat = (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure ((Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a)
-> (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a
-> Term (F v a a) v a
forall a b. (a -> b) -> a -> b
$ \case
Apps' f :: Term (F v a a) v a
f@(Constructor' ConstructorReference
r) [Term (F v a a) v a]
args -> ConstructorReference
-> Term (F v a a) v a
-> [Term (F v a a) v a]
-> Maybe (Term (F v a a) v a)
sat ConstructorReference
r Term (F v a a) v a
f [Term (F v a a) v a]
args
Apps' f :: Term (F v a a) v a
f@(Request' ConstructorReference
r) [Term (F v a a) v a]
args -> ConstructorReference
-> Term (F v a a) v a
-> [Term (F v a a) v a]
-> Maybe (Term (F v a a) v a)
sat ConstructorReference
r Term (F v a a) v a
f [Term (F v a a) v a]
args
f :: Term (F v a a) v a
f@(Constructor' ConstructorReference
r) -> ConstructorReference
-> Term (F v a a) v a
-> [Term (F v a a) v a]
-> Maybe (Term (F v a a) v a)
sat ConstructorReference
r Term (F v a a) v a
f []
f :: Term (F v a a) v a
f@(Request' ConstructorReference
r) -> ConstructorReference
-> Term (F v a a) v a
-> [Term (F v a a) v a]
-> Maybe (Term (F v a a) v a)
sat ConstructorReference
r Term (F v a a) v a
f []
Term (F v a a) v a
_ -> Maybe (Term (F v a a) v a)
forall a. Maybe a
Nothing
where
frsh :: Set b -> p -> (Set b, b)
frsh Set b
avoid p
_ =
let v :: b
v = Set b -> b -> b
forall v. Var v => Set v -> v -> v
Var.freshIn Set b
avoid (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Type -> b
forall v. Var v => Type -> v
typed Type
Var.Eta
in (b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
Set.insert b
v Set b
avoid, b
v)
sat :: ConstructorReference
-> Term (F v a a) v a
-> [Term (F v a a) v a]
-> Maybe (Term (F v a a) v a)
sat ConstructorReference
r Term (F v a a) v a
f [Term (F v a a) v a]
args = case ConstructorReference -> Map ConstructorReference Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ConstructorReference
r Map ConstructorReference Int
dat of
Just Int
n
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n,
[v]
vs <- (Set v, [v]) -> [v]
forall a b. (a, b) -> b
snd ((Set v, [v]) -> [v]) -> (Set v, [v]) -> [v]
forall a b. (a -> b) -> a -> b
$ (Set v -> Int -> (Set v, v)) -> Set v -> [Int] -> (Set v, [v])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Set v -> Int -> (Set v, v)
forall {b} {p}. Var b => Set b -> p -> (Set b, b)
frsh Set v
fvs [Int
1 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m],
[Term (F v a a) v a]
nargs <- a -> v -> Term (F v a a) v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
forall a. Monoid a => a
mempty (v -> Term (F v a a) v a) -> [v] -> [Term (F v a a) v a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
vs ->
Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a. a -> Maybe a
Just (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> ([Term (F v a a) v a] -> Term (F v a a) v a)
-> [Term (F v a a) v a]
-> Maybe (Term (F v a a) v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [v] -> Term (F v a a) v a -> Term (F v a a) v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
forall a. Monoid a => a
mempty [v]
vs (Term (F v a a) v a -> Term (F v a a) v a)
-> ([Term (F v a a) v a] -> Term (F v a a) v a)
-> [Term (F v a a) v a]
-> Term (F v a a) v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term (F v a a) v a -> [Term (F v a a) v a] -> Term (F v a a) v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' Term (F v a a) v a
f ([Term (F v a a) v a] -> Maybe (Term (F v a a) v a))
-> [Term (F v a a) v a] -> Maybe (Term (F v a a) v a)
forall a b. (a -> b) -> a -> b
$ [Term (F v a a) v a]
args' [Term (F v a a) v a]
-> [Term (F v a a) v a] -> [Term (F v a a) v a]
forall a. [a] -> [a] -> [a]
++ [Term (F v a a) v a]
nargs
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n,
([Term (F v a a) v a]
sargs, [Term (F v a a) v a]
eargs) <- Int
-> [Term (F v a a) v a]
-> ([Term (F v a a) v a], [Term (F v a a) v a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [Term (F v a a) v a]
args',
v
sv <- Set v -> v -> v
forall v. Var v => Set v -> v -> v
Var.freshIn Set v
fvs (v -> v) -> v -> v
forall a b. (a -> b) -> a -> b
$ Type -> v
forall v. Var v => Type -> v
typed Type
Var.Eta ->
Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a. a -> Maybe a
Just
(Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> (Term (F v a a) v a -> Term (F v a a) v a)
-> Term (F v a a) v a
-> Maybe (Term (F v a a) v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> [(v, Term (F v a a) v a)]
-> Term (F v a a) v a
-> Term (F v a a) v a
forall a v vt at ap.
(Semigroup a, Ord v) =>
Bool
-> [(v, Term2 vt at ap v a)]
-> Term2 vt at ap v a
-> Term2 vt at ap v a
let1' Bool
False [(v
sv, Term (F v a a) v a -> [Term (F v a a) v a] -> Term (F v a a) v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' Term (F v a a) v a
f [Term (F v a a) v a]
sargs)]
(Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a b. (a -> b) -> a -> b
$ Term (F v a a) v a -> [Term (F v a a) v a] -> Term (F v a a) v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' (a -> v -> Term (F v a a) v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
forall a. Monoid a => a
mempty v
sv) [Term (F v a a) v a]
eargs
Maybe Int
_ -> Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a. a -> Maybe a
Just (Term (F v a a) v a -> [Term (F v a a) v a] -> Term (F v a a) v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' Term (F v a a) v a
f [Term (F v a a) v a]
args')
where
m :: Int
m = [Term (F v a a) v a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Term (F v a a) v a]
args
fvs :: Set v
fvs = (Term (F v a a) v a -> Set v) -> [Term (F v a a) v a] -> Set v
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term (F v a a) v a -> Set v
forall vt v a. Term' vt v a -> Set v
freeVars [Term (F v a a) v a]
args
args' :: [Term (F v a a) v a]
args' = Map ConstructorReference Int
-> Term (F v a a) v a -> Term (F v a a) v a
forall v a.
(Var v, Monoid a) =>
Map ConstructorReference Int -> Term v a -> Term v a
saturate Map ConstructorReference Int
dat (Term (F v a a) v a -> Term (F v a a) v a)
-> [Term (F v a a) v a] -> [Term (F v a a) v a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Term (F v a a) v a]
args
addDefaultCases :: (Var v) => (Monoid a) => Text -> Term v a -> Term v a
addDefaultCases :: forall v a. (Var v, Monoid a) => Text -> Term v a -> Term v a
addDefaultCases = (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure ((Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a)
-> (Text -> Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Text
-> Term (F v a a) v a
-> Term (F v a a) v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall v a.
(Var v, Monoid a) =>
Text -> Term v a -> Maybe (Term v a)
defaultCaseVisitor
defaultCaseVisitor ::
(Var v) => (Monoid a) => Text -> Term v a -> Maybe (Term v a)
defaultCaseVisitor :: forall v a.
(Var v, Monoid a) =>
Text -> Term v a -> Maybe (Term v a)
defaultCaseVisitor Text
func m :: Term v a
m@(Match' Term v a
scrut [MatchCase a (Term v a)]
cases)
| Term v a
scrut <- Text -> Term v a -> Term v a
forall v a. (Var v, Monoid a) => Text -> Term v a -> Term v a
addDefaultCases Text
func Term v a
scrut,
[MatchCase a (Term v a)]
cases <- (Term v a -> Term v a)
-> MatchCase a (Term v a) -> MatchCase a (Term v a)
forall a b. (a -> b) -> MatchCase a a -> MatchCase a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Term v a -> Term v a
forall v a. (Var v, Monoid a) => Text -> Term v a -> Term v a
addDefaultCases Text
func) (MatchCase a (Term v a) -> MatchCase a (Term v a))
-> [MatchCase a (Term v a)] -> [MatchCase a (Term v a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MatchCase a (Term v a)]
cases =
Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ a -> Term v a -> [MatchCase a (Term v a)] -> Term v a
forall v a vt at.
Ord v =>
a
-> Term2 vt at a v a
-> [MatchCase a (Term2 vt at a v a)]
-> Term2 vt at a v a
match a
a Term v a
scrut ([MatchCase a (Term v a)]
cases [MatchCase a (Term v a)]
-> [MatchCase a (Term v a)] -> [MatchCase a (Term v a)]
forall a. [a] -> [a] -> [a]
++ [MatchCase a (Term v a)
dflt])
where
a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
m
v :: v
v = Set v -> v -> v
forall v. Var v => Set v -> v -> v
Var.freshIn Set v
forall a. Monoid a => a
mempty (v -> v) -> v -> v
forall a b. (a -> b) -> a -> b
$ Type -> v
forall v. Var v => Type -> v
typed Type
Var.Blank
txt :: Text
txt = Text
"pattern match failure in function `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
func Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
msg :: Term v a
msg = a -> Text -> Term v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
text a
a Text
txt
bu :: Term v a
bu = a -> Reference -> Term v a
forall v a vt at ap. Ord v => a -> Reference -> Term2 vt at ap v a
ref a
a (Text -> Reference
forall t h. t -> Reference' t h
Builtin Text
"bug")
dflt :: MatchCase a (Term v a)
dflt =
Pattern a -> Maybe (Term v a) -> Term v a -> MatchCase a (Term v a)
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
MatchCase (a -> Pattern a
forall loc. loc -> Pattern loc
P.Var a
a) Maybe (Term v a)
forall a. Maybe a
Nothing
(Term v a -> MatchCase a (Term v a))
-> (Term v a -> Term v a) -> Term v a -> MatchCase a (Term v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> v -> Term v a -> Term v a
forall v a (f :: * -> *).
Ord v =>
a -> v -> Term f v a -> Term f v a
ABT.abs' a
a v
v
(Term v a -> MatchCase a (Term v a))
-> Term v a -> MatchCase a (Term v a)
forall a b. (a -> b) -> a -> b
$ Term v a -> [(a, Term v a)] -> Term v a
forall v vt at ap a.
Ord v =>
Term2 vt at ap v a
-> [(a, Term2 vt at ap v a)] -> Term2 vt at ap v a
apps Term v a
bu [(a
a, [Term v a] -> Term v a
forall v a vt at ap.
(Var v, Monoid a) =>
[Term2 vt at ap v a] -> Term2 vt at ap v a
Ty.tupleTerm [Term v a
msg, a -> v -> Term v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
a v
v])]
defaultCaseVisitor Text
_ Term v a
_ = Maybe (Term v a)
forall a. Maybe a
Nothing
inlineAlias :: (Var v) => (Monoid a) => Term v a -> Term v a
inlineAlias :: forall v a. (Var v, Monoid a) => Term v a -> Term v a
inlineAlias = (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure ((Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a)
-> (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a
-> Term (F v a a) v a
forall a b. (a -> b) -> a -> b
$ \case
Let1Named' v
v b :: Term (F v a a) v a
b@(Var' v
_) Term (F v a a) v a
e -> Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a. a -> Maybe a
Just (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> (Term (F v a a) v a -> Term (F v a a) v a)
-> Term (F v a a) v a
-> Maybe (Term (F v a a) v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term (F v a a) v a -> Term (F v a a) v a
forall v a. (Var v, Monoid a) => Term v a -> Term v a
inlineAlias (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a b. (a -> b) -> a -> b
$ v -> Term (F v a a) v a -> Term (F v a a) v a -> Term (F v a a) v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
v -> Term f v a -> Term f v a -> Term f v a
ABT.subst v
v Term (F v a a) v a
b Term (F v a a) v a
e
Term (F v a a) v a
_ -> Maybe (Term (F v a a) v a)
forall a. Maybe a
Nothing
minimizeCyclesOrCrash :: (Var v) => Term v a -> Term v a
minimizeCyclesOrCrash :: forall v a. Var v => Term v a -> Term v a
minimizeCyclesOrCrash Term v a
t = case Term v a -> Either (NonEmpty (v, [a])) (Term v a)
forall v vt a.
Var v =>
Term' vt v a -> Either (NonEmpty (v, [a])) (Term' vt v a)
minimize' Term v a
t of
Right Term v a
t -> Term v a
t
Left NonEmpty (v, [a])
e ->
String -> Term v a
forall a. HasCallStack => String -> a
internalBug (String -> Term v a) -> String -> Term v a
forall a b. (a -> b) -> a -> b
$
String
"tried to minimize let rec with duplicate definitions: "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ [v] -> String
forall a. Show a => a -> String
show ((v, [a]) -> v
forall a b. (a, b) -> a
fst ((v, [a]) -> v) -> [(v, [a])] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (v, [a]) -> [(v, [a])]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (v, [a])
e)
data Mem = UN | BX deriving (Mem -> Mem -> Bool
(Mem -> Mem -> Bool) -> (Mem -> Mem -> Bool) -> Eq Mem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mem -> Mem -> Bool
== :: Mem -> Mem -> Bool
$c/= :: Mem -> Mem -> Bool
/= :: Mem -> Mem -> Bool
Eq, Eq Mem
Eq Mem =>
(Mem -> Mem -> Ordering)
-> (Mem -> Mem -> Bool)
-> (Mem -> Mem -> Bool)
-> (Mem -> Mem -> Bool)
-> (Mem -> Mem -> Bool)
-> (Mem -> Mem -> Mem)
-> (Mem -> Mem -> Mem)
-> Ord Mem
Mem -> Mem -> Bool
Mem -> Mem -> Ordering
Mem -> Mem -> Mem
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
$ccompare :: Mem -> Mem -> Ordering
compare :: Mem -> Mem -> Ordering
$c< :: Mem -> Mem -> Bool
< :: Mem -> Mem -> Bool
$c<= :: Mem -> Mem -> Bool
<= :: Mem -> Mem -> Bool
$c> :: Mem -> Mem -> Bool
> :: Mem -> Mem -> Bool
$c>= :: Mem -> Mem -> Bool
>= :: Mem -> Mem -> Bool
$cmax :: Mem -> Mem -> Mem
max :: Mem -> Mem -> Mem
$cmin :: Mem -> Mem -> Mem
min :: Mem -> Mem -> Mem
Ord, Int -> Mem -> ShowS
[Mem] -> ShowS
Mem -> String
(Int -> Mem -> ShowS)
-> (Mem -> String) -> ([Mem] -> ShowS) -> Show Mem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mem -> ShowS
showsPrec :: Int -> Mem -> ShowS
$cshow :: Mem -> String
show :: Mem -> String
$cshowList :: [Mem] -> ShowS
showList :: [Mem] -> ShowS
Show, Int -> Mem
Mem -> Int
Mem -> [Mem]
Mem -> Mem
Mem -> Mem -> [Mem]
Mem -> Mem -> Mem -> [Mem]
(Mem -> Mem)
-> (Mem -> Mem)
-> (Int -> Mem)
-> (Mem -> Int)
-> (Mem -> [Mem])
-> (Mem -> Mem -> [Mem])
-> (Mem -> Mem -> [Mem])
-> (Mem -> Mem -> Mem -> [Mem])
-> Enum Mem
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Mem -> Mem
succ :: Mem -> Mem
$cpred :: Mem -> Mem
pred :: Mem -> Mem
$ctoEnum :: Int -> Mem
toEnum :: Int -> Mem
$cfromEnum :: Mem -> Int
fromEnum :: Mem -> Int
$cenumFrom :: Mem -> [Mem]
enumFrom :: Mem -> [Mem]
$cenumFromThen :: Mem -> Mem -> [Mem]
enumFromThen :: Mem -> Mem -> [Mem]
$cenumFromTo :: Mem -> Mem -> [Mem]
enumFromTo :: Mem -> Mem -> [Mem]
$cenumFromThenTo :: Mem -> Mem -> Mem -> [Mem]
enumFromThenTo :: Mem -> Mem -> Mem -> [Mem]
Enum)
data CTE v s
= ST (Direction Word16) [v] [Mem] s
| LZ v (Either Reference v) [v]
deriving (Int -> CTE v s -> ShowS
[CTE v s] -> ShowS
CTE v s -> String
(Int -> CTE v s -> ShowS)
-> (CTE v s -> String) -> ([CTE v s] -> ShowS) -> Show (CTE v s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v s. (Show s, Show v) => Int -> CTE v s -> ShowS
forall v s. (Show s, Show v) => [CTE v s] -> ShowS
forall v s. (Show s, Show v) => CTE v s -> String
$cshowsPrec :: forall v s. (Show s, Show v) => Int -> CTE v s -> ShowS
showsPrec :: Int -> CTE v s -> ShowS
$cshow :: forall v s. (Show s, Show v) => CTE v s -> String
show :: CTE v s -> String
$cshowList :: forall v s. (Show s, Show v) => [CTE v s] -> ShowS
showList :: [CTE v s] -> ShowS
Show)
pattern ST1 :: Direction Word16 -> v -> Mem -> s -> CTE v s
pattern $mST1 :: forall {r} {v} {s}.
CTE v s
-> (Direction Word16 -> v -> Mem -> s -> r) -> ((# #) -> r) -> r
$bST1 :: forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 d v m s = ST d [v] [m] s
data ANormalF v e
= ALet (Direction Word16) [Mem] e e
| AName (Either Reference v) [v] e
| ALit Lit
| ABLit Lit
| AMatch v (Branched e)
| AShift Reference e
| AHnd [Reference] v e
| AApp (Func v) [v]
| AFrc v
| AVar v
deriving (Int -> ANormalF v e -> ShowS
[ANormalF v e] -> ShowS
ANormalF v e -> String
(Int -> ANormalF v e -> ShowS)
-> (ANormalF v e -> String)
-> ([ANormalF v e] -> ShowS)
-> Show (ANormalF v e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v e. (Show e, Show v) => Int -> ANormalF v e -> ShowS
forall v e. (Show e, Show v) => [ANormalF v e] -> ShowS
forall v e. (Show e, Show v) => ANormalF v e -> String
$cshowsPrec :: forall v e. (Show e, Show v) => Int -> ANormalF v e -> ShowS
showsPrec :: Int -> ANormalF v e -> ShowS
$cshow :: forall v e. (Show e, Show v) => ANormalF v e -> String
show :: ANormalF v e -> String
$cshowList :: forall v e. (Show e, Show v) => [ANormalF v e] -> ShowS
showList :: [ANormalF v e] -> ShowS
Show, ANormalF v e -> ANormalF v e -> Bool
(ANormalF v e -> ANormalF v e -> Bool)
-> (ANormalF v e -> ANormalF v e -> Bool) -> Eq (ANormalF v e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v e. (Eq e, Eq v) => ANormalF v e -> ANormalF v e -> Bool
$c== :: forall v e. (Eq e, Eq v) => ANormalF v e -> ANormalF v e -> Bool
== :: ANormalF v e -> ANormalF v e -> Bool
$c/= :: forall v e. (Eq e, Eq v) => ANormalF v e -> ANormalF v e -> Bool
/= :: ANormalF v e -> ANormalF v e -> Bool
Eq)
newtype RTag = RTag Word64
deriving stock (RTag -> RTag -> Bool
(RTag -> RTag -> Bool) -> (RTag -> RTag -> Bool) -> Eq RTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RTag -> RTag -> Bool
== :: RTag -> RTag -> Bool
$c/= :: RTag -> RTag -> Bool
/= :: RTag -> RTag -> Bool
Eq, Eq RTag
Eq RTag =>
(RTag -> RTag -> Ordering)
-> (RTag -> RTag -> Bool)
-> (RTag -> RTag -> Bool)
-> (RTag -> RTag -> Bool)
-> (RTag -> RTag -> Bool)
-> (RTag -> RTag -> RTag)
-> (RTag -> RTag -> RTag)
-> Ord RTag
RTag -> RTag -> Bool
RTag -> RTag -> Ordering
RTag -> RTag -> RTag
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
$ccompare :: RTag -> RTag -> Ordering
compare :: RTag -> RTag -> Ordering
$c< :: RTag -> RTag -> Bool
< :: RTag -> RTag -> Bool
$c<= :: RTag -> RTag -> Bool
<= :: RTag -> RTag -> Bool
$c> :: RTag -> RTag -> Bool
> :: RTag -> RTag -> Bool
$c>= :: RTag -> RTag -> Bool
>= :: RTag -> RTag -> Bool
$cmax :: RTag -> RTag -> RTag
max :: RTag -> RTag -> RTag
$cmin :: RTag -> RTag -> RTag
min :: RTag -> RTag -> RTag
Ord, Int -> RTag -> ShowS
[RTag] -> ShowS
RTag -> String
(Int -> RTag -> ShowS)
-> (RTag -> String) -> ([RTag] -> ShowS) -> Show RTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RTag -> ShowS
showsPrec :: Int -> RTag -> ShowS
$cshow :: RTag -> String
show :: RTag -> String
$cshowList :: [RTag] -> ShowS
showList :: [RTag] -> ShowS
Show, ReadPrec [RTag]
ReadPrec RTag
Int -> ReadS RTag
ReadS [RTag]
(Int -> ReadS RTag)
-> ReadS [RTag] -> ReadPrec RTag -> ReadPrec [RTag] -> Read RTag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RTag
readsPrec :: Int -> ReadS RTag
$creadList :: ReadS [RTag]
readList :: ReadS [RTag]
$creadPrec :: ReadPrec RTag
readPrec :: ReadPrec RTag
$creadListPrec :: ReadPrec [RTag]
readListPrec :: ReadPrec [RTag]
Read)
deriving newtype (Int -> RTag
RTag -> Int
(RTag -> Int) -> (Int -> RTag) -> EnumKey RTag
forall k. (k -> Int) -> (Int -> k) -> EnumKey k
$ckeyToInt :: RTag -> Int
keyToInt :: RTag -> Int
$cintToKey :: Int -> RTag
intToKey :: Int -> RTag
EC.EnumKey)
newtype CTag = CTag Word16
deriving stock (CTag -> CTag -> Bool
(CTag -> CTag -> Bool) -> (CTag -> CTag -> Bool) -> Eq CTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CTag -> CTag -> Bool
== :: CTag -> CTag -> Bool
$c/= :: CTag -> CTag -> Bool
/= :: CTag -> CTag -> Bool
Eq, Eq CTag
Eq CTag =>
(CTag -> CTag -> Ordering)
-> (CTag -> CTag -> Bool)
-> (CTag -> CTag -> Bool)
-> (CTag -> CTag -> Bool)
-> (CTag -> CTag -> Bool)
-> (CTag -> CTag -> CTag)
-> (CTag -> CTag -> CTag)
-> Ord CTag
CTag -> CTag -> Bool
CTag -> CTag -> Ordering
CTag -> CTag -> CTag
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
$ccompare :: CTag -> CTag -> Ordering
compare :: CTag -> CTag -> Ordering
$c< :: CTag -> CTag -> Bool
< :: CTag -> CTag -> Bool
$c<= :: CTag -> CTag -> Bool
<= :: CTag -> CTag -> Bool
$c> :: CTag -> CTag -> Bool
> :: CTag -> CTag -> Bool
$c>= :: CTag -> CTag -> Bool
>= :: CTag -> CTag -> Bool
$cmax :: CTag -> CTag -> CTag
max :: CTag -> CTag -> CTag
$cmin :: CTag -> CTag -> CTag
min :: CTag -> CTag -> CTag
Ord, Int -> CTag -> ShowS
[CTag] -> ShowS
CTag -> String
(Int -> CTag -> ShowS)
-> (CTag -> String) -> ([CTag] -> ShowS) -> Show CTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CTag -> ShowS
showsPrec :: Int -> CTag -> ShowS
$cshow :: CTag -> String
show :: CTag -> String
$cshowList :: [CTag] -> ShowS
showList :: [CTag] -> ShowS
Show, ReadPrec [CTag]
ReadPrec CTag
Int -> ReadS CTag
ReadS [CTag]
(Int -> ReadS CTag)
-> ReadS [CTag] -> ReadPrec CTag -> ReadPrec [CTag] -> Read CTag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CTag
readsPrec :: Int -> ReadS CTag
$creadList :: ReadS [CTag]
readList :: ReadS [CTag]
$creadPrec :: ReadPrec CTag
readPrec :: ReadPrec CTag
$creadListPrec :: ReadPrec [CTag]
readListPrec :: ReadPrec [CTag]
Read)
deriving newtype (Int -> CTag
CTag -> Int
(CTag -> Int) -> (Int -> CTag) -> EnumKey CTag
forall k. (k -> Int) -> (Int -> k) -> EnumKey k
$ckeyToInt :: CTag -> Int
keyToInt :: CTag -> Int
$cintToKey :: Int -> CTag
intToKey :: Int -> CTag
EC.EnumKey)
class Tag t where rawTag :: t -> Word64
instance Tag RTag where rawTag :: RTag -> Word64
rawTag (RTag Word64
w) = Word64
w
instance Tag CTag where rawTag :: CTag -> Word64
rawTag (CTag Word16
w) = Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w
packTags :: RTag -> CTag -> Word64
packTags :: RTag -> CTag -> Word64
packTags (RTag Word64
rt) (CTag Word16
ct) = Word64
ri Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
ci
where
ri :: Word64
ri = Word64
rt Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
16
ci :: Word64
ci = Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
ct
unpackTags :: Word64 -> (RTag, CTag)
unpackTags :: Word64 -> (RTag, CTag)
unpackTags Word64
w = (Word64 -> RTag
RTag (Word64 -> RTag) -> Word64 -> RTag
forall a b. (a -> b) -> a -> b
$ Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
16, Word16 -> CTag
CTag (Word16 -> CTag) -> (Word64 -> Word16) -> Word64 -> CTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> CTag) -> Word64 -> CTag
forall a b. (a -> b) -> a -> b
$ Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xFFFF)
maskTags :: Word64 -> Word64
maskTags :: Word64 -> Word64
maskTags Word64
w = Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xFFFF
ensureRTag :: (Ord n, Show n, Num n) => String -> n -> r -> r
ensureRTag :: forall n r. (Ord n, Show n, Num n) => String -> n -> r -> r
ensureRTag String
s n
n r
x
| n
n n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
0xFFFFFFFFFFFF =
String -> r
forall a. HasCallStack => String -> a
internalBug (String -> r) -> String -> r
forall a b. (a -> b) -> a -> b
$ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"@RTag: too large: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ n -> String
forall a. Show a => a -> String
show n
n
| Bool
otherwise = r
x
ensureCTag :: (Ord n, Show n, Num n) => String -> n -> r -> r
ensureCTag :: forall n r. (Ord n, Show n, Num n) => String -> n -> r -> r
ensureCTag String
s n
n r
x
| n
n n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
0xFFFF =
String -> r
forall a. HasCallStack => String -> a
internalBug (String -> r) -> String -> r
forall a b. (a -> b) -> a -> b
$ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"@CTag: too large: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ n -> String
forall a. Show a => a -> String
show n
n
| Bool
otherwise = r
x
instance Enum RTag where
toEnum :: Int -> RTag
toEnum Int
i = String -> Int -> RTag -> RTag
forall n r. (Ord n, Show n, Num n) => String -> n -> r -> r
ensureRTag String
"toEnum" Int
i (RTag -> RTag) -> (Word64 -> RTag) -> Word64 -> RTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RTag
RTag (Word64 -> RTag) -> Word64 -> RTag
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a. Enum a => Int -> a
toEnum Int
i
fromEnum :: RTag -> Int
fromEnum (RTag Word64
w) = Word64 -> Int
forall a. Enum a => a -> Int
fromEnum Word64
w
instance Enum CTag where
toEnum :: Int -> CTag
toEnum Int
i = String -> Int -> CTag -> CTag
forall n r. (Ord n, Show n, Num n) => String -> n -> r -> r
ensureCTag String
"toEnum" Int
i (CTag -> CTag) -> (Word16 -> CTag) -> Word16 -> CTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CTag
CTag (Word16 -> CTag) -> Word16 -> CTag
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a. Enum a => Int -> a
toEnum Int
i
fromEnum :: CTag -> Int
fromEnum (CTag Word16
w) = Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
w
instance Num RTag where
fromInteger :: Integer -> RTag
fromInteger Integer
i = String -> Integer -> RTag -> RTag
forall n r. (Ord n, Show n, Num n) => String -> n -> r -> r
ensureRTag String
"fromInteger" Integer
i (RTag -> RTag) -> (Word64 -> RTag) -> Word64 -> RTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RTag
RTag (Word64 -> RTag) -> Word64 -> RTag
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
i
+ :: RTag -> RTag -> RTag
(+) = String -> RTag -> RTag -> RTag
forall a. HasCallStack => String -> a
internalBug String
"RTag: +"
* :: RTag -> RTag -> RTag
(*) = String -> RTag -> RTag -> RTag
forall a. HasCallStack => String -> a
internalBug String
"RTag: *"
abs :: RTag -> RTag
abs = String -> RTag -> RTag
forall a. HasCallStack => String -> a
internalBug String
"RTag: abs"
signum :: RTag -> RTag
signum = String -> RTag -> RTag
forall a. HasCallStack => String -> a
internalBug String
"RTag: signum"
negate :: RTag -> RTag
negate = String -> RTag -> RTag
forall a. HasCallStack => String -> a
internalBug String
"RTag: negate"
instance Num CTag where
fromInteger :: Integer -> CTag
fromInteger Integer
i = String -> Integer -> CTag -> CTag
forall n r. (Ord n, Show n, Num n) => String -> n -> r -> r
ensureCTag String
"fromInteger" Integer
i (CTag -> CTag) -> (Word16 -> CTag) -> Word16 -> CTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CTag
CTag (Word16 -> CTag) -> Word16 -> CTag
forall a b. (a -> b) -> a -> b
$ Integer -> Word16
forall a. Num a => Integer -> a
fromInteger Integer
i
+ :: CTag -> CTag -> CTag
(+) = String -> CTag -> CTag -> CTag
forall a. HasCallStack => String -> a
internalBug String
"CTag: +"
* :: CTag -> CTag -> CTag
(*) = String -> CTag -> CTag -> CTag
forall a. HasCallStack => String -> a
internalBug String
"CTag: *"
abs :: CTag -> CTag
abs = String -> CTag -> CTag
forall a. HasCallStack => String -> a
internalBug String
"CTag: abs"
signum :: CTag -> CTag
signum = String -> CTag -> CTag
forall a. HasCallStack => String -> a
internalBug String
"CTag: signum"
negate :: CTag -> CTag
negate = String -> CTag -> CTag
forall a. HasCallStack => String -> a
internalBug String
"CTag: negate"
instance Functor (ANormalF v) where
fmap :: forall a b. (a -> b) -> ANormalF v a -> ANormalF v b
fmap a -> b
_ (AVar v
v) = v -> ANormalF v b
forall v e. v -> ANormalF v e
AVar v
v
fmap a -> b
_ (ALit Lit
l) = Lit -> ANormalF v b
forall v e. Lit -> ANormalF v e
ALit Lit
l
fmap a -> b
_ (ABLit Lit
l) = Lit -> ANormalF v b
forall v e. Lit -> ANormalF v e
ABLit Lit
l
fmap a -> b
f (ALet Direction Word16
d [Mem]
m a
bn a
bo) = Direction Word16 -> [Mem] -> b -> b -> ANormalF v b
forall v e. Direction Word16 -> [Mem] -> e -> e -> ANormalF v e
ALet Direction Word16
d [Mem]
m (a -> b
f a
bn) (a -> b
f a
bo)
fmap a -> b
f (AName Either Reference v
n [v]
as a
bo) = Either Reference v -> [v] -> b -> ANormalF v b
forall v e. Either Reference v -> [v] -> e -> ANormalF v e
AName Either Reference v
n [v]
as (b -> ANormalF v b) -> b -> ANormalF v b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
bo
fmap a -> b
f (AMatch v
v Branched a
br) = v -> Branched b -> ANormalF v b
forall v e. v -> Branched e -> ANormalF v e
AMatch v
v (Branched b -> ANormalF v b) -> Branched b -> ANormalF v b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> Branched a -> Branched b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Branched a
br
fmap a -> b
f (AHnd [Reference]
rs v
h a
e) = [Reference] -> v -> b -> ANormalF v b
forall v e. [Reference] -> v -> e -> ANormalF v e
AHnd [Reference]
rs v
h (b -> ANormalF v b) -> b -> ANormalF v b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
e
fmap a -> b
f (AShift Reference
i a
e) = Reference -> b -> ANormalF v b
forall v e. Reference -> e -> ANormalF v e
AShift Reference
i (b -> ANormalF v b) -> b -> ANormalF v b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
e
fmap a -> b
_ (AFrc v
v) = v -> ANormalF v b
forall v e. v -> ANormalF v e
AFrc v
v
fmap a -> b
_ (AApp Func v
f [v]
args) = Func v -> [v] -> ANormalF v b
forall v e. Func v -> [v] -> ANormalF v e
AApp Func v
f [v]
args
instance Bifunctor ANormalF where
bimap :: forall a b c d.
(a -> b) -> (c -> d) -> ANormalF a c -> ANormalF b d
bimap a -> b
f c -> d
_ (AVar a
v) = b -> ANormalF b d
forall v e. v -> ANormalF v e
AVar (a -> b
f a
v)
bimap a -> b
_ c -> d
_ (ALit Lit
l) = Lit -> ANormalF b d
forall v e. Lit -> ANormalF v e
ALit Lit
l
bimap a -> b
_ c -> d
_ (ABLit Lit
l) = Lit -> ANormalF b d
forall v e. Lit -> ANormalF v e
ABLit Lit
l
bimap a -> b
_ c -> d
g (ALet Direction Word16
d [Mem]
m c
bn c
bo) = Direction Word16 -> [Mem] -> d -> d -> ANormalF b d
forall v e. Direction Word16 -> [Mem] -> e -> e -> ANormalF v e
ALet Direction Word16
d [Mem]
m (c -> d
g c
bn) (c -> d
g c
bo)
bimap a -> b
f c -> d
g (AName Either Reference a
n [a]
as c
bo) = Either Reference b -> [b] -> d -> ANormalF b d
forall v e. Either Reference v -> [v] -> e -> ANormalF v e
AName (a -> b
f (a -> b) -> Either Reference a -> Either Reference b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Reference a
n) (a -> b
f (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as) (d -> ANormalF b d) -> d -> ANormalF b d
forall a b. (a -> b) -> a -> b
$ c -> d
g c
bo
bimap a -> b
f c -> d
g (AMatch a
v Branched c
br) = b -> Branched d -> ANormalF b d
forall v e. v -> Branched e -> ANormalF v e
AMatch (a -> b
f a
v) (Branched d -> ANormalF b d) -> Branched d -> ANormalF b d
forall a b. (a -> b) -> a -> b
$ (c -> d) -> Branched c -> Branched d
forall a b. (a -> b) -> Branched a -> Branched b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g Branched c
br
bimap a -> b
f c -> d
g (AHnd [Reference]
rs a
v c
e) = [Reference] -> b -> d -> ANormalF b d
forall v e. [Reference] -> v -> e -> ANormalF v e
AHnd [Reference]
rs (a -> b
f a
v) (d -> ANormalF b d) -> d -> ANormalF b d
forall a b. (a -> b) -> a -> b
$ c -> d
g c
e
bimap a -> b
_ c -> d
g (AShift Reference
i c
e) = Reference -> d -> ANormalF b d
forall v e. Reference -> e -> ANormalF v e
AShift Reference
i (d -> ANormalF b d) -> d -> ANormalF b d
forall a b. (a -> b) -> a -> b
$ c -> d
g c
e
bimap a -> b
f c -> d
_ (AFrc a
v) = b -> ANormalF b d
forall v e. v -> ANormalF v e
AFrc (a -> b
f a
v)
bimap a -> b
f c -> d
_ (AApp Func a
fu [a]
args) = Func b -> [b] -> ANormalF b d
forall v e. Func v -> [v] -> ANormalF v e
AApp ((a -> b) -> Func a -> Func b
forall a b. (a -> b) -> Func a -> Func b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Func a
fu) ([b] -> ANormalF b d) -> [b] -> ANormalF b d
forall a b. (a -> b) -> a -> b
$ (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
args
instance Bifoldable ANormalF where
bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> ANormalF a b -> m
bifoldMap a -> m
f b -> m
_ (AVar a
v) = a -> m
f a
v
bifoldMap a -> m
_ b -> m
_ (ALit Lit
_) = m
forall a. Monoid a => a
mempty
bifoldMap a -> m
_ b -> m
_ (ABLit Lit
_) = m
forall a. Monoid a => a
mempty
bifoldMap a -> m
_ b -> m
g (ALet Direction Word16
_ [Mem]
_ b
b b
e) = b -> m
g b
b m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
e
bifoldMap a -> m
f b -> m
g (AName Either Reference a
n [a]
as b
e) = (a -> m) -> Either Reference a -> m
forall m a. Monoid m => (a -> m) -> Either Reference a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Either Reference a
n m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> [a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f [a]
as m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
e
bifoldMap a -> m
f b -> m
g (AMatch a
v Branched b
br) = a -> m
f a
v m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (b -> m) -> Branched b -> m
forall m a. Monoid m => (a -> m) -> Branched a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g Branched b
br
bifoldMap a -> m
f b -> m
g (AHnd [Reference]
_ a
h b
e) = a -> m
f a
h m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
e
bifoldMap a -> m
_ b -> m
g (AShift Reference
_ b
e) = b -> m
g b
e
bifoldMap a -> m
f b -> m
_ (AFrc a
v) = a -> m
f a
v
bifoldMap a -> m
f b -> m
_ (AApp Func a
func [a]
args) = (a -> m) -> Func a -> m
forall m a. Monoid m => (a -> m) -> Func a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Func a
func m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> [a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f [a]
args
instance ABTN.Align ANormalF where
align :: forall (g :: * -> *) vl vr vs el er es.
Applicative g =>
(vl -> vr -> g vs)
-> (el -> er -> g es)
-> ANormalF vl el
-> ANormalF vr er
-> Maybe (g (ANormalF vs es))
align vl -> vr -> g vs
f el -> er -> g es
_ (AVar vl
u) (AVar vr
v) = g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a. a -> Maybe a
Just (g (ANormalF vs es) -> Maybe (g (ANormalF vs es)))
-> g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a b. (a -> b) -> a -> b
$ vs -> ANormalF vs es
forall v e. v -> ANormalF v e
AVar (vs -> ANormalF vs es) -> g vs -> g (ANormalF vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vl -> vr -> g vs
f vl
u vr
v
align vl -> vr -> g vs
_ el -> er -> g es
_ (ALit Lit
l) (ALit Lit
r)
| Lit
l Lit -> Lit -> Bool
forall a. Eq a => a -> a -> Bool
== Lit
r = g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a. a -> Maybe a
Just (g (ANormalF vs es) -> Maybe (g (ANormalF vs es)))
-> g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a b. (a -> b) -> a -> b
$ ANormalF vs es -> g (ANormalF vs es)
forall a. a -> g a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lit -> ANormalF vs es
forall v e. Lit -> ANormalF v e
ALit Lit
l)
align vl -> vr -> g vs
_ el -> er -> g es
_ (ABLit Lit
l) (ABLit Lit
r)
| Lit
l Lit -> Lit -> Bool
forall a. Eq a => a -> a -> Bool
== Lit
r = g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a. a -> Maybe a
Just (g (ANormalF vs es) -> Maybe (g (ANormalF vs es)))
-> g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a b. (a -> b) -> a -> b
$ ANormalF vs es -> g (ANormalF vs es)
forall a. a -> g a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lit -> ANormalF vs es
forall v e. Lit -> ANormalF v e
ABLit Lit
l)
align vl -> vr -> g vs
_ el -> er -> g es
g (ALet Direction Word16
dl [Mem]
ccl el
bl el
el) (ALet Direction Word16
dr [Mem]
ccr er
br er
er)
| Direction Word16
dl Direction Word16 -> Direction Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Direction Word16
dr,
[Mem]
ccl [Mem] -> [Mem] -> Bool
forall a. Eq a => a -> a -> Bool
== [Mem]
ccr =
g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a. a -> Maybe a
Just (g (ANormalF vs es) -> Maybe (g (ANormalF vs es)))
-> g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a b. (a -> b) -> a -> b
$ Direction Word16 -> [Mem] -> es -> es -> ANormalF vs es
forall v e. Direction Word16 -> [Mem] -> e -> e -> ANormalF v e
ALet Direction Word16
dl [Mem]
ccl (es -> es -> ANormalF vs es) -> g es -> g (es -> ANormalF vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> el -> er -> g es
g el
bl er
br g (es -> ANormalF vs es) -> g es -> g (ANormalF vs es)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> el -> er -> g es
g el
el er
er
align vl -> vr -> g vs
f el -> er -> g es
g (AName Either Reference vl
hl [vl]
asl el
el) (AName Either Reference vr
hr [vr]
asr er
er)
| [vl] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [vl]
asl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [vr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [vr]
asr,
Just g (Either Reference vs)
hs <- (vl -> vr -> g vs)
-> Either Reference vl
-> Either Reference vr
-> Maybe (g (Either Reference vs))
forall (f :: * -> *) l r s.
Applicative f =>
(l -> r -> f s)
-> Either Reference l
-> Either Reference r
-> Maybe (f (Either Reference s))
alignEither vl -> vr -> g vs
f Either Reference vl
hl Either Reference vr
hr =
g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a. a -> Maybe a
Just (g (ANormalF vs es) -> Maybe (g (ANormalF vs es)))
-> g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a b. (a -> b) -> a -> b
$
Either Reference vs -> [vs] -> es -> ANormalF vs es
forall v e. Either Reference v -> [v] -> e -> ANormalF v e
AName
(Either Reference vs -> [vs] -> es -> ANormalF vs es)
-> g (Either Reference vs) -> g ([vs] -> es -> ANormalF vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g (Either Reference vs)
hs
g ([vs] -> es -> ANormalF vs es)
-> g [vs] -> g (es -> ANormalF vs es)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((vl, vr) -> g vs) -> [(vl, vr)] -> g [vs]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((vl -> vr -> g vs) -> (vl, vr) -> g vs
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry vl -> vr -> g vs
f) ([vl] -> [vr] -> [(vl, vr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [vl]
asl [vr]
asr)
g (es -> ANormalF vs es) -> g es -> g (ANormalF vs es)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> el -> er -> g es
g el
el er
er
align vl -> vr -> g vs
f el -> er -> g es
g (AMatch vl
vl Branched el
bsl) (AMatch vr
vr Branched er
bsr)
| Just g (Branched es)
bss <- (el -> er -> g es)
-> Branched el -> Branched er -> Maybe (g (Branched es))
forall (f :: * -> *) el er es.
Applicative f =>
(el -> er -> f es)
-> Branched el -> Branched er -> Maybe (f (Branched es))
alignBranch el -> er -> g es
g Branched el
bsl Branched er
bsr =
g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a. a -> Maybe a
Just (g (ANormalF vs es) -> Maybe (g (ANormalF vs es)))
-> g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a b. (a -> b) -> a -> b
$ vs -> Branched es -> ANormalF vs es
forall v e. v -> Branched e -> ANormalF v e
AMatch (vs -> Branched es -> ANormalF vs es)
-> g vs -> g (Branched es -> ANormalF vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vl -> vr -> g vs
f vl
vl vr
vr g (Branched es -> ANormalF vs es)
-> g (Branched es) -> g (ANormalF vs es)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g (Branched es)
bss
align vl -> vr -> g vs
f el -> er -> g es
g (AHnd [Reference]
rl vl
hl el
bl) (AHnd [Reference]
rr vr
hr er
br)
| [Reference]
rl [Reference] -> [Reference] -> Bool
forall a. Eq a => a -> a -> Bool
== [Reference]
rr = g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a. a -> Maybe a
Just (g (ANormalF vs es) -> Maybe (g (ANormalF vs es)))
-> g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a b. (a -> b) -> a -> b
$ [Reference] -> vs -> es -> ANormalF vs es
forall v e. [Reference] -> v -> e -> ANormalF v e
AHnd [Reference]
rl (vs -> es -> ANormalF vs es) -> g vs -> g (es -> ANormalF vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vl -> vr -> g vs
f vl
hl vr
hr g (es -> ANormalF vs es) -> g es -> g (ANormalF vs es)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> el -> er -> g es
g el
bl er
br
align vl -> vr -> g vs
_ el -> er -> g es
g (AShift Reference
rl el
bl) (AShift Reference
rr er
br)
| Reference
rl Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
rr = g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a. a -> Maybe a
Just (g (ANormalF vs es) -> Maybe (g (ANormalF vs es)))
-> g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a b. (a -> b) -> a -> b
$ Reference -> es -> ANormalF vs es
forall v e. Reference -> e -> ANormalF v e
AShift Reference
rl (es -> ANormalF vs es) -> g es -> g (ANormalF vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> el -> er -> g es
g el
bl er
br
align vl -> vr -> g vs
f el -> er -> g es
_ (AFrc vl
u) (AFrc vr
v) = g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a. a -> Maybe a
Just (g (ANormalF vs es) -> Maybe (g (ANormalF vs es)))
-> g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a b. (a -> b) -> a -> b
$ vs -> ANormalF vs es
forall v e. v -> ANormalF v e
AFrc (vs -> ANormalF vs es) -> g vs -> g (ANormalF vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vl -> vr -> g vs
f vl
u vr
v
align vl -> vr -> g vs
f el -> er -> g es
_ (AApp Func vl
hl [vl]
asl) (AApp Func vr
hr [vr]
asr)
| Just g (Func vs)
hs <- (vl -> vr -> g vs) -> Func vl -> Func vr -> Maybe (g (Func vs))
forall (f :: * -> *) vl vr vs.
Applicative f =>
(vl -> vr -> f vs) -> Func vl -> Func vr -> Maybe (f (Func vs))
alignFunc vl -> vr -> g vs
f Func vl
hl Func vr
hr,
[vl] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [vl]
asl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [vr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [vr]
asr =
g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a. a -> Maybe a
Just (g (ANormalF vs es) -> Maybe (g (ANormalF vs es)))
-> g (ANormalF vs es) -> Maybe (g (ANormalF vs es))
forall a b. (a -> b) -> a -> b
$ Func vs -> [vs] -> ANormalF vs es
forall v e. Func v -> [v] -> ANormalF v e
AApp (Func vs -> [vs] -> ANormalF vs es)
-> g (Func vs) -> g ([vs] -> ANormalF vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g (Func vs)
hs g ([vs] -> ANormalF vs es) -> g [vs] -> g (ANormalF vs es)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((vl, vr) -> g vs) -> [(vl, vr)] -> g [vs]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((vl -> vr -> g vs) -> (vl, vr) -> g vs
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry vl -> vr -> g vs
f) ([vl] -> [vr] -> [(vl, vr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [vl]
asl [vr]
asr)
align vl -> vr -> g vs
_ el -> er -> g es
_ ANormalF vl el
_ ANormalF vr er
_ = Maybe (g (ANormalF vs es))
forall a. Maybe a
Nothing
alignEither ::
(Applicative f) =>
(l -> r -> f s) ->
Either Reference l ->
Either Reference r ->
Maybe (f (Either Reference s))
alignEither :: forall (f :: * -> *) l r s.
Applicative f =>
(l -> r -> f s)
-> Either Reference l
-> Either Reference r
-> Maybe (f (Either Reference s))
alignEither l -> r -> f s
_ (Left Reference
rl) (Left Reference
rr) | Reference
rl Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
rr = f (Either Reference s) -> Maybe (f (Either Reference s))
forall a. a -> Maybe a
Just (f (Either Reference s) -> Maybe (f (Either Reference s)))
-> (Either Reference s -> f (Either Reference s))
-> Either Reference s
-> Maybe (f (Either Reference s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Reference s -> f (Either Reference s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Reference s -> Maybe (f (Either Reference s)))
-> Either Reference s -> Maybe (f (Either Reference s))
forall a b. (a -> b) -> a -> b
$ Reference -> Either Reference s
forall a b. a -> Either a b
Left Reference
rl
alignEither l -> r -> f s
f (Right l
u) (Right r
v) = f (Either Reference s) -> Maybe (f (Either Reference s))
forall a. a -> Maybe a
Just (f (Either Reference s) -> Maybe (f (Either Reference s)))
-> f (Either Reference s) -> Maybe (f (Either Reference s))
forall a b. (a -> b) -> a -> b
$ s -> Either Reference s
forall a b. b -> Either a b
Right (s -> Either Reference s) -> f s -> f (Either Reference s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l -> r -> f s
f l
u r
v
alignEither l -> r -> f s
_ Either Reference l
_ Either Reference r
_ = Maybe (f (Either Reference s))
forall a. Maybe a
Nothing
alignMaybe ::
(Applicative f) =>
(l -> r -> f s) ->
Maybe l ->
Maybe r ->
Maybe (f (Maybe s))
alignMaybe :: forall (f :: * -> *) l r s.
Applicative f =>
(l -> r -> f s) -> Maybe l -> Maybe r -> Maybe (f (Maybe s))
alignMaybe l -> r -> f s
f (Just l
l) (Just r
r) = f (Maybe s) -> Maybe (f (Maybe s))
forall a. a -> Maybe a
Just (f (Maybe s) -> Maybe (f (Maybe s)))
-> f (Maybe s) -> Maybe (f (Maybe s))
forall a b. (a -> b) -> a -> b
$ s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> f s -> f (Maybe s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l -> r -> f s
f l
l r
r
alignMaybe l -> r -> f s
_ Maybe l
Nothing Maybe r
Nothing = f (Maybe s) -> Maybe (f (Maybe s))
forall a. a -> Maybe a
Just (Maybe s -> f (Maybe s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe s
forall a. Maybe a
Nothing)
alignMaybe l -> r -> f s
_ Maybe l
_ Maybe r
_ = Maybe (f (Maybe s))
forall a. Maybe a
Nothing
alignFunc ::
(Applicative f) =>
(vl -> vr -> f vs) ->
Func vl ->
Func vr ->
Maybe (f (Func vs))
alignFunc :: forall (f :: * -> *) vl vr vs.
Applicative f =>
(vl -> vr -> f vs) -> Func vl -> Func vr -> Maybe (f (Func vs))
alignFunc vl -> vr -> f vs
f (FVar vl
u) (FVar vr
v) = f (Func vs) -> Maybe (f (Func vs))
forall a. a -> Maybe a
Just (f (Func vs) -> Maybe (f (Func vs)))
-> f (Func vs) -> Maybe (f (Func vs))
forall a b. (a -> b) -> a -> b
$ vs -> Func vs
forall v. v -> Func v
FVar (vs -> Func vs) -> f vs -> f (Func vs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vl -> vr -> f vs
f vl
u vr
v
alignFunc vl -> vr -> f vs
_ (FComb Reference
rl) (FComb Reference
rr) | Reference
rl Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
rr = f (Func vs) -> Maybe (f (Func vs))
forall a. a -> Maybe a
Just (f (Func vs) -> Maybe (f (Func vs)))
-> (Func vs -> f (Func vs)) -> Func vs -> Maybe (f (Func vs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Func vs -> f (Func vs)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Func vs -> Maybe (f (Func vs))) -> Func vs -> Maybe (f (Func vs))
forall a b. (a -> b) -> a -> b
$ Reference -> Func vs
forall v. Reference -> Func v
FComb Reference
rl
alignFunc vl -> vr -> f vs
f (FCont vl
u) (FCont vr
v) = f (Func vs) -> Maybe (f (Func vs))
forall a. a -> Maybe a
Just (f (Func vs) -> Maybe (f (Func vs)))
-> f (Func vs) -> Maybe (f (Func vs))
forall a b. (a -> b) -> a -> b
$ vs -> Func vs
forall v. v -> Func v
FCont (vs -> Func vs) -> f vs -> f (Func vs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vl -> vr -> f vs
f vl
u vr
v
alignFunc vl -> vr -> f vs
_ (FCon Reference
rl CTag
tl) (FCon Reference
rr CTag
tr)
| Reference
rl Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
rr, CTag
tl CTag -> CTag -> Bool
forall a. Eq a => a -> a -> Bool
== CTag
tr = f (Func vs) -> Maybe (f (Func vs))
forall a. a -> Maybe a
Just (f (Func vs) -> Maybe (f (Func vs)))
-> (Func vs -> f (Func vs)) -> Func vs -> Maybe (f (Func vs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Func vs -> f (Func vs)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Func vs -> Maybe (f (Func vs))) -> Func vs -> Maybe (f (Func vs))
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> Func vs
forall v. Reference -> CTag -> Func v
FCon Reference
rl CTag
tl
alignFunc vl -> vr -> f vs
_ (FReq Reference
rl CTag
tl) (FReq Reference
rr CTag
tr)
| Reference
rl Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
rr, CTag
tl CTag -> CTag -> Bool
forall a. Eq a => a -> a -> Bool
== CTag
tr = f (Func vs) -> Maybe (f (Func vs))
forall a. a -> Maybe a
Just (f (Func vs) -> Maybe (f (Func vs)))
-> (Func vs -> f (Func vs)) -> Func vs -> Maybe (f (Func vs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Func vs -> f (Func vs)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Func vs -> Maybe (f (Func vs))) -> Func vs -> Maybe (f (Func vs))
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> Func vs
forall v. Reference -> CTag -> Func v
FReq Reference
rl CTag
tl
alignFunc vl -> vr -> f vs
_ (FPrim Either POp Word64
ol) (FPrim Either POp Word64
or)
| Either POp Word64
ol Either POp Word64 -> Either POp Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Either POp Word64
or = f (Func vs) -> Maybe (f (Func vs))
forall a. a -> Maybe a
Just (f (Func vs) -> Maybe (f (Func vs)))
-> (Func vs -> f (Func vs)) -> Func vs -> Maybe (f (Func vs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Func vs -> f (Func vs)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Func vs -> Maybe (f (Func vs))) -> Func vs -> Maybe (f (Func vs))
forall a b. (a -> b) -> a -> b
$ Either POp Word64 -> Func vs
forall v. Either POp Word64 -> Func v
FPrim Either POp Word64
ol
alignFunc vl -> vr -> f vs
_ Func vl
_ Func vr
_ = Maybe (f (Func vs))
forall a. Maybe a
Nothing
alignBranch ::
(Applicative f) =>
(el -> er -> f es) ->
Branched el ->
Branched er ->
Maybe (f (Branched es))
alignBranch :: forall (f :: * -> *) el er es.
Applicative f =>
(el -> er -> f es)
-> Branched el -> Branched er -> Maybe (f (Branched es))
alignBranch el -> er -> f es
_ Branched el
MatchEmpty Branched er
MatchEmpty = f (Branched es) -> Maybe (f (Branched es))
forall a. a -> Maybe a
Just (f (Branched es) -> Maybe (f (Branched es)))
-> f (Branched es) -> Maybe (f (Branched es))
forall a b. (a -> b) -> a -> b
$ Branched es -> f (Branched es)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Branched es
forall e. Branched e
MatchEmpty
alignBranch el -> er -> f es
f (MatchIntegral EnumMap Word64 el
bl Maybe el
dl) (MatchIntegral EnumMap Word64 er
br Maybe er
dr)
| EnumMap Word64 el -> EnumSet Word64
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap Word64 el
bl EnumSet Word64 -> EnumSet Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== EnumMap Word64 er -> EnumSet Word64
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap Word64 er
br,
Just f (Maybe es)
ds <- (el -> er -> f es) -> Maybe el -> Maybe er -> Maybe (f (Maybe es))
forall (f :: * -> *) l r s.
Applicative f =>
(l -> r -> f s) -> Maybe l -> Maybe r -> Maybe (f (Maybe s))
alignMaybe el -> er -> f es
f Maybe el
dl Maybe er
dr =
f (Branched es) -> Maybe (f (Branched es))
forall a. a -> Maybe a
Just (f (Branched es) -> Maybe (f (Branched es)))
-> f (Branched es) -> Maybe (f (Branched es))
forall a b. (a -> b) -> a -> b
$
EnumMap Word64 es -> Maybe es -> Branched es
forall e. EnumMap Word64 e -> Maybe e -> Branched e
MatchIntegral
(EnumMap Word64 es -> Maybe es -> Branched es)
-> f (EnumMap Word64 es) -> f (Maybe es -> Branched es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (el -> er -> f es)
-> EnumMap Word64 el -> EnumMap Word64 er -> f (EnumMap Word64 es)
forall (f :: * -> *) a b c k.
Applicative f =>
(a -> b -> f c) -> EnumMap k a -> EnumMap k b -> f (EnumMap k c)
interverse el -> er -> f es
f EnumMap Word64 el
bl EnumMap Word64 er
br
f (Maybe es -> Branched es) -> f (Maybe es) -> f (Branched es)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Maybe es)
ds
alignBranch el -> er -> f es
f (MatchText Map Text el
bl Maybe el
dl) (MatchText Map Text er
br Maybe er
dr)
| Map Text el -> Set Text
forall k a. Map k a -> Set k
Map.keysSet Map Text el
bl Set Text -> Set Text -> Bool
forall a. Eq a => a -> a -> Bool
== Map Text er -> Set Text
forall k a. Map k a -> Set k
Map.keysSet Map Text er
br,
Just f (Maybe es)
ds <- (el -> er -> f es) -> Maybe el -> Maybe er -> Maybe (f (Maybe es))
forall (f :: * -> *) l r s.
Applicative f =>
(l -> r -> f s) -> Maybe l -> Maybe r -> Maybe (f (Maybe s))
alignMaybe el -> er -> f es
f Maybe el
dl Maybe er
dr =
f (Branched es) -> Maybe (f (Branched es))
forall a. a -> Maybe a
Just (f (Branched es) -> Maybe (f (Branched es)))
-> f (Branched es) -> Maybe (f (Branched es))
forall a b. (a -> b) -> a -> b
$
Map Text es -> Maybe es -> Branched es
forall e. Map Text e -> Maybe e -> Branched e
MatchText
(Map Text es -> Maybe es -> Branched es)
-> f (Map Text es) -> f (Maybe es -> Branched es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (f es -> f es) -> Map Text (f es) -> f (Map Text es)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Text a -> f (Map Text b)
traverse f es -> f es
forall a. a -> a
id ((el -> er -> f es) -> Map Text el -> Map Text er -> Map Text (f es)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith el -> er -> f es
f Map Text el
bl Map Text er
br)
f (Maybe es -> Branched es) -> f (Maybe es) -> f (Branched es)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Maybe es)
ds
alignBranch el -> er -> f es
f (MatchRequest Map Reference (EnumMap CTag ([Mem], el))
bl el
pl) (MatchRequest Map Reference (EnumMap CTag ([Mem], er))
br er
pr)
| Map Reference (EnumMap CTag ([Mem], el)) -> Set Reference
forall k a. Map k a -> Set k
Map.keysSet Map Reference (EnumMap CTag ([Mem], el))
bl Set Reference -> Set Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Map Reference (EnumMap CTag ([Mem], er)) -> Set Reference
forall k a. Map k a -> Set k
Map.keysSet Map Reference (EnumMap CTag ([Mem], er))
br,
(Reference -> Bool) -> Set Reference -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Reference -> Bool
p (Map Reference (EnumMap CTag ([Mem], el)) -> Set Reference
forall k a. Map k a -> Set k
Map.keysSet Map Reference (EnumMap CTag ([Mem], el))
bl) =
f (Branched es) -> Maybe (f (Branched es))
forall a. a -> Maybe a
Just (f (Branched es) -> Maybe (f (Branched es)))
-> f (Branched es) -> Maybe (f (Branched es))
forall a b. (a -> b) -> a -> b
$
Map Reference (EnumMap CTag ([Mem], es)) -> es -> Branched es
forall e.
Map Reference (EnumMap CTag ([Mem], e)) -> e -> Branched e
MatchRequest
(Map Reference (EnumMap CTag ([Mem], es)) -> es -> Branched es)
-> f (Map Reference (EnumMap CTag ([Mem], es)))
-> f (es -> Branched es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (f (EnumMap CTag ([Mem], es)) -> f (EnumMap CTag ([Mem], es)))
-> Map Reference (f (EnumMap CTag ([Mem], es)))
-> f (Map Reference (EnumMap CTag ([Mem], es)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Reference a -> f (Map Reference b)
traverse f (EnumMap CTag ([Mem], es)) -> f (EnumMap CTag ([Mem], es))
forall a. a -> a
id ((EnumMap CTag ([Mem], el)
-> EnumMap CTag ([Mem], er) -> f (EnumMap CTag ([Mem], es)))
-> Map Reference (EnumMap CTag ([Mem], el))
-> Map Reference (EnumMap CTag ([Mem], er))
-> Map Reference (f (EnumMap CTag ([Mem], es)))
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith ((([Mem], el) -> ([Mem], er) -> f ([Mem], es))
-> EnumMap CTag ([Mem], el)
-> EnumMap CTag ([Mem], er)
-> f (EnumMap CTag ([Mem], es))
forall (f :: * -> *) a b c k.
Applicative f =>
(a -> b -> f c) -> EnumMap k a -> EnumMap k b -> f (EnumMap k c)
interverse ((el -> er -> f es) -> ([Mem], el) -> ([Mem], er) -> f ([Mem], es)
forall (f :: * -> *) l r s a.
Functor f =>
(l -> r -> f s) -> (a, l) -> (a, r) -> f (a, s)
alignCCs el -> er -> f es
f)) Map Reference (EnumMap CTag ([Mem], el))
bl Map Reference (EnumMap CTag ([Mem], er))
br)
f (es -> Branched es) -> f es -> f (Branched es)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> el -> er -> f es
f el
pl er
pr
where
p :: Reference -> Bool
p Reference
r = EnumMap CTag ([Mem], el) -> EnumSet CTag
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap CTag ([Mem], el)
hsl EnumSet CTag -> EnumSet CTag -> Bool
forall a. Eq a => a -> a -> Bool
== EnumMap CTag ([Mem], er) -> EnumSet CTag
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap CTag ([Mem], er)
hsr Bool -> Bool -> Bool
&& (CTag -> Bool) -> [CTag] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CTag -> Bool
q (EnumMap CTag ([Mem], el) -> [CTag]
forall k a. EnumKey k => EnumMap k a -> [k]
keys EnumMap CTag ([Mem], el)
hsl)
where
hsl :: EnumMap CTag ([Mem], el)
hsl = Map Reference (EnumMap CTag ([Mem], el))
bl Map Reference (EnumMap CTag ([Mem], el))
-> Reference -> EnumMap CTag ([Mem], el)
forall k a. Ord k => Map k a -> k -> a
Map.! Reference
r
hsr :: EnumMap CTag ([Mem], er)
hsr = Map Reference (EnumMap CTag ([Mem], er))
br Map Reference (EnumMap CTag ([Mem], er))
-> Reference -> EnumMap CTag ([Mem], er)
forall k a. Ord k => Map k a -> k -> a
Map.! Reference
r
q :: CTag -> Bool
q CTag
t = ([Mem], el) -> [Mem]
forall a b. (a, b) -> a
fst (EnumMap CTag ([Mem], el)
hsl EnumMap CTag ([Mem], el) -> CTag -> ([Mem], el)
forall k a. EnumKey k => EnumMap k a -> k -> a
! CTag
t) [Mem] -> [Mem] -> Bool
forall a. Eq a => a -> a -> Bool
== ([Mem], er) -> [Mem]
forall a b. (a, b) -> a
fst (EnumMap CTag ([Mem], er)
hsr EnumMap CTag ([Mem], er) -> CTag -> ([Mem], er)
forall k a. EnumKey k => EnumMap k a -> k -> a
! CTag
t)
alignBranch el -> er -> f es
f (MatchData Reference
rfl EnumMap CTag ([Mem], el)
bl Maybe el
dl) (MatchData Reference
rfr EnumMap CTag ([Mem], er)
br Maybe er
dr)
| Reference
rfl Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
rfr,
EnumMap CTag ([Mem], el) -> EnumSet CTag
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap CTag ([Mem], el)
bl EnumSet CTag -> EnumSet CTag -> Bool
forall a. Eq a => a -> a -> Bool
== EnumMap CTag ([Mem], er) -> EnumSet CTag
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap CTag ([Mem], er)
br,
(CTag -> Bool) -> [CTag] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\CTag
t -> ([Mem], el) -> [Mem]
forall a b. (a, b) -> a
fst (EnumMap CTag ([Mem], el)
bl EnumMap CTag ([Mem], el) -> CTag -> ([Mem], el)
forall k a. EnumKey k => EnumMap k a -> k -> a
! CTag
t) [Mem] -> [Mem] -> Bool
forall a. Eq a => a -> a -> Bool
== ([Mem], er) -> [Mem]
forall a b. (a, b) -> a
fst (EnumMap CTag ([Mem], er)
br EnumMap CTag ([Mem], er) -> CTag -> ([Mem], er)
forall k a. EnumKey k => EnumMap k a -> k -> a
! CTag
t)) (EnumMap CTag ([Mem], el) -> [CTag]
forall k a. EnumKey k => EnumMap k a -> [k]
keys EnumMap CTag ([Mem], el)
bl),
Just f (Maybe es)
ds <- (el -> er -> f es) -> Maybe el -> Maybe er -> Maybe (f (Maybe es))
forall (f :: * -> *) l r s.
Applicative f =>
(l -> r -> f s) -> Maybe l -> Maybe r -> Maybe (f (Maybe s))
alignMaybe el -> er -> f es
f Maybe el
dl Maybe er
dr =
f (Branched es) -> Maybe (f (Branched es))
forall a. a -> Maybe a
Just (f (Branched es) -> Maybe (f (Branched es)))
-> f (Branched es) -> Maybe (f (Branched es))
forall a b. (a -> b) -> a -> b
$ Reference -> EnumMap CTag ([Mem], es) -> Maybe es -> Branched es
forall e.
Reference -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched e
MatchData Reference
rfl (EnumMap CTag ([Mem], es) -> Maybe es -> Branched es)
-> f (EnumMap CTag ([Mem], es)) -> f (Maybe es -> Branched es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Mem], el) -> ([Mem], er) -> f ([Mem], es))
-> EnumMap CTag ([Mem], el)
-> EnumMap CTag ([Mem], er)
-> f (EnumMap CTag ([Mem], es))
forall (f :: * -> *) a b c k.
Applicative f =>
(a -> b -> f c) -> EnumMap k a -> EnumMap k b -> f (EnumMap k c)
interverse ((el -> er -> f es) -> ([Mem], el) -> ([Mem], er) -> f ([Mem], es)
forall (f :: * -> *) l r s a.
Functor f =>
(l -> r -> f s) -> (a, l) -> (a, r) -> f (a, s)
alignCCs el -> er -> f es
f) EnumMap CTag ([Mem], el)
bl EnumMap CTag ([Mem], er)
br f (Maybe es -> Branched es) -> f (Maybe es) -> f (Branched es)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Maybe es)
ds
alignBranch el -> er -> f es
f (MatchSum EnumMap Word64 ([Mem], el)
bl) (MatchSum EnumMap Word64 ([Mem], er)
br)
| EnumMap Word64 ([Mem], el) -> EnumSet Word64
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap Word64 ([Mem], el)
bl EnumSet Word64 -> EnumSet Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== EnumMap Word64 ([Mem], er) -> EnumSet Word64
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap Word64 ([Mem], er)
br,
(Word64 -> Bool) -> [Word64] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Word64
w -> ([Mem], el) -> [Mem]
forall a b. (a, b) -> a
fst (EnumMap Word64 ([Mem], el)
bl EnumMap Word64 ([Mem], el) -> Word64 -> ([Mem], el)
forall k a. EnumKey k => EnumMap k a -> k -> a
! Word64
w) [Mem] -> [Mem] -> Bool
forall a. Eq a => a -> a -> Bool
== ([Mem], er) -> [Mem]
forall a b. (a, b) -> a
fst (EnumMap Word64 ([Mem], er)
br EnumMap Word64 ([Mem], er) -> Word64 -> ([Mem], er)
forall k a. EnumKey k => EnumMap k a -> k -> a
! Word64
w)) (EnumMap Word64 ([Mem], el) -> [Word64]
forall k a. EnumKey k => EnumMap k a -> [k]
keys EnumMap Word64 ([Mem], el)
bl) =
f (Branched es) -> Maybe (f (Branched es))
forall a. a -> Maybe a
Just (f (Branched es) -> Maybe (f (Branched es)))
-> f (Branched es) -> Maybe (f (Branched es))
forall a b. (a -> b) -> a -> b
$ EnumMap Word64 ([Mem], es) -> Branched es
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], es) -> Branched es)
-> f (EnumMap Word64 ([Mem], es)) -> f (Branched es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Mem], el) -> ([Mem], er) -> f ([Mem], es))
-> EnumMap Word64 ([Mem], el)
-> EnumMap Word64 ([Mem], er)
-> f (EnumMap Word64 ([Mem], es))
forall (f :: * -> *) a b c k.
Applicative f =>
(a -> b -> f c) -> EnumMap k a -> EnumMap k b -> f (EnumMap k c)
interverse ((el -> er -> f es) -> ([Mem], el) -> ([Mem], er) -> f ([Mem], es)
forall (f :: * -> *) l r s a.
Functor f =>
(l -> r -> f s) -> (a, l) -> (a, r) -> f (a, s)
alignCCs el -> er -> f es
f) EnumMap Word64 ([Mem], el)
bl EnumMap Word64 ([Mem], er)
br
alignBranch el -> er -> f es
f (MatchNumeric Reference
rl EnumMap Word64 el
bl Maybe el
dl) (MatchNumeric Reference
rr EnumMap Word64 er
br Maybe er
dr)
| Reference
rl Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
rr,
EnumMap Word64 el -> EnumSet Word64
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap Word64 el
bl EnumSet Word64 -> EnumSet Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== EnumMap Word64 er -> EnumSet Word64
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap Word64 er
br,
Just f (Maybe es)
ds <- (el -> er -> f es) -> Maybe el -> Maybe er -> Maybe (f (Maybe es))
forall (f :: * -> *) l r s.
Applicative f =>
(l -> r -> f s) -> Maybe l -> Maybe r -> Maybe (f (Maybe s))
alignMaybe el -> er -> f es
f Maybe el
dl Maybe er
dr =
f (Branched es) -> Maybe (f (Branched es))
forall a. a -> Maybe a
Just (f (Branched es) -> Maybe (f (Branched es)))
-> f (Branched es) -> Maybe (f (Branched es))
forall a b. (a -> b) -> a -> b
$
Reference -> EnumMap Word64 es -> Maybe es -> Branched es
forall e. Reference -> EnumMap Word64 e -> Maybe e -> Branched e
MatchNumeric Reference
rl
(EnumMap Word64 es -> Maybe es -> Branched es)
-> f (EnumMap Word64 es) -> f (Maybe es -> Branched es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (el -> er -> f es)
-> EnumMap Word64 el -> EnumMap Word64 er -> f (EnumMap Word64 es)
forall (f :: * -> *) a b c k.
Applicative f =>
(a -> b -> f c) -> EnumMap k a -> EnumMap k b -> f (EnumMap k c)
interverse el -> er -> f es
f EnumMap Word64 el
bl EnumMap Word64 er
br
f (Maybe es -> Branched es) -> f (Maybe es) -> f (Branched es)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Maybe es)
ds
alignBranch el -> er -> f es
_ Branched el
_ Branched er
_ = Maybe (f (Branched es))
forall a. Maybe a
Nothing
alignCCs :: (Functor f) => (l -> r -> f s) -> (a, l) -> (a, r) -> f (a, s)
alignCCs :: forall (f :: * -> *) l r s a.
Functor f =>
(l -> r -> f s) -> (a, l) -> (a, r) -> f (a, s)
alignCCs l -> r -> f s
f (a
ccs, l
l) (a
_, r
r) = (,) a
ccs (s -> (a, s)) -> f s -> f (a, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l -> r -> f s
f l
l r
r
matchLit :: Term v a -> Maybe Lit
matchLit :: forall v a. Term v a -> Maybe Lit
matchLit (Int' Int64
i) = Lit -> Maybe Lit
forall a. a -> Maybe a
Just (Lit -> Maybe Lit) -> Lit -> Maybe Lit
forall a b. (a -> b) -> a -> b
$ Int64 -> Lit
I Int64
i
matchLit (Nat' Word64
n) = Lit -> Maybe Lit
forall a. a -> Maybe a
Just (Lit -> Maybe Lit) -> Lit -> Maybe Lit
forall a b. (a -> b) -> a -> b
$ Word64 -> Lit
N Word64
n
matchLit (Float' Double
f) = Lit -> Maybe Lit
forall a. a -> Maybe a
Just (Lit -> Maybe Lit) -> Lit -> Maybe Lit
forall a b. (a -> b) -> a -> b
$ Double -> Lit
F Double
f
matchLit (Text' Text
t) = Lit -> Maybe Lit
forall a. a -> Maybe a
Just (Lit -> Maybe Lit) -> Lit -> Maybe Lit
forall a b. (a -> b) -> a -> b
$ Text -> Lit
T (Text -> Text
Util.Text.fromText Text
t)
matchLit (Char' Char
c) = Lit -> Maybe Lit
forall a. a -> Maybe a
Just (Lit -> Maybe Lit) -> Lit -> Maybe Lit
forall a b. (a -> b) -> a -> b
$ Char -> Lit
C Char
c
matchLit Term (F v a a) v a
_ = Maybe Lit
forall a. Maybe a
Nothing
pattern TLet ::
(ABT.Var v) =>
Direction Word16 ->
v ->
Mem ->
ABTN.Term ANormalF v ->
ABTN.Term ANormalF v ->
ABTN.Term ANormalF v
pattern $mTLet :: forall {r} {v}.
Var v =>
Term ANormalF v
-> (Direction Word16
-> v -> Mem -> Term ANormalF v -> Term ANormalF v -> r)
-> ((# #) -> r)
-> r
$bTLet :: forall v.
Var v =>
Direction Word16
-> v
-> Mem
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
TLet d v m bn bo = ABTN.TTm (ALet d [m] bn (ABTN.TAbs v bo))
pattern TLetD ::
(ABT.Var v) =>
v ->
Mem ->
ABTN.Term ANormalF v ->
ABTN.Term ANormalF v ->
ABTN.Term ANormalF v
pattern $mTLetD :: forall {r} {v}.
Var v =>
Term ANormalF v
-> (v -> Mem -> Term ANormalF v -> Term ANormalF v -> r)
-> ((# #) -> r)
-> r
$bTLetD :: forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v m bn bo = ABTN.TTm (ALet Direct [m] bn (ABTN.TAbs v bo))
pattern TLets ::
(ABT.Var v) =>
Direction Word16 ->
[v] ->
[Mem] ->
ABTN.Term ANormalF v ->
ABTN.Term ANormalF v ->
ABTN.Term ANormalF v
pattern $mTLets :: forall {r} {v}.
Var v =>
Term ANormalF v
-> (Direction Word16
-> [v] -> [Mem] -> Term ANormalF v -> Term ANormalF v -> r)
-> ((# #) -> r)
-> r
$bTLets :: forall v.
Var v =>
Direction Word16
-> [v]
-> [Mem]
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
TLets d vs ms bn bo = ABTN.TTm (ALet d ms bn (ABTN.TAbss vs bo))
pattern TName ::
(ABT.Var v) =>
v ->
Either Reference v ->
[v] ->
ABTN.Term ANormalF v ->
ABTN.Term ANormalF v
pattern $mTName :: forall {r} {v}.
Var v =>
Term ANormalF v
-> (v -> Either Reference v -> [v] -> Term ANormalF v -> r)
-> ((# #) -> r)
-> r
$bTName :: forall v.
Var v =>
v
-> Either Reference v -> [v] -> Term ANormalF v -> Term ANormalF v
TName v f as bo = ABTN.TTm (AName f as (ABTN.TAbs v bo))
pattern Lit' :: Lit -> Term v a
pattern $mLit' :: forall {r} {v} {a}. Term v a -> (Lit -> r) -> ((# #) -> r) -> r
Lit' l <- (matchLit -> Just l)
pattern TLit ::
(ABT.Var v) =>
Lit ->
ABTN.Term ANormalF v
pattern $mTLit :: forall {r} {v}.
Var v =>
Term ANormalF v -> (Lit -> r) -> ((# #) -> r) -> r
$bTLit :: forall v. Var v => Lit -> Term ANormalF v
TLit l = ABTN.TTm (ALit l)
pattern TBLit ::
(ABT.Var v) =>
Lit ->
ABTN.Term ANormalF v
pattern $mTBLit :: forall {r} {v}.
Var v =>
Term ANormalF v -> (Lit -> r) -> ((# #) -> r) -> r
$bTBLit :: forall v. Var v => Lit -> Term ANormalF v
TBLit l = ABTN.TTm (ABLit l)
pattern TApp ::
(ABT.Var v) =>
Func v ->
[v] ->
ABTN.Term ANormalF v
pattern $mTApp :: forall {r} {v}.
Var v =>
Term ANormalF v -> (Func v -> [v] -> r) -> ((# #) -> r) -> r
$bTApp :: forall v. Var v => Func v -> [v] -> Term ANormalF v
TApp f args = ABTN.TTm (AApp f args)
pattern AApv :: v -> [v] -> ANormalF v e
pattern $mAApv :: forall {r} {v} {e}.
ANormalF v e -> (v -> [v] -> r) -> ((# #) -> r) -> r
$bAApv :: forall v e. v -> [v] -> ANormalF v e
AApv v args = AApp (FVar v) args
pattern TApv ::
(ABT.Var v) =>
v ->
[v] ->
ABTN.Term ANormalF v
pattern $mTApv :: forall {r} {v}.
Var v =>
Term ANormalF v -> (v -> [v] -> r) -> ((# #) -> r) -> r
$bTApv :: forall v. Var v => v -> [v] -> Term ANormalF v
TApv v args = TApp (FVar v) args
pattern ACom :: Reference -> [v] -> ANormalF v e
pattern $mACom :: forall {r} {v} {e}.
ANormalF v e -> (Reference -> [v] -> r) -> ((# #) -> r) -> r
$bACom :: forall v e. Reference -> [v] -> ANormalF v e
ACom r args = AApp (FComb r) args
pattern TCom ::
(ABT.Var v) =>
Reference ->
[v] ->
ABTN.Term ANormalF v
pattern $mTCom :: forall {r} {v}.
Var v =>
Term ANormalF v -> (Reference -> [v] -> r) -> ((# #) -> r) -> r
$bTCom :: forall v. Var v => Reference -> [v] -> Term ANormalF v
TCom r args = TApp (FComb r) args
pattern ACon :: Reference -> CTag -> [v] -> ANormalF v e
pattern $mACon :: forall {r} {v} {e}.
ANormalF v e
-> (Reference -> CTag -> [v] -> r) -> ((# #) -> r) -> r
$bACon :: forall v e. Reference -> CTag -> [v] -> ANormalF v e
ACon r t args = AApp (FCon r t) args
pattern TCon ::
(ABT.Var v) =>
Reference ->
CTag ->
[v] ->
ABTN.Term ANormalF v
pattern $mTCon :: forall {r} {v}.
Var v =>
Term ANormalF v
-> (Reference -> CTag -> [v] -> r) -> ((# #) -> r) -> r
$bTCon :: forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon r t args = TApp (FCon r t) args
pattern AKon :: v -> [v] -> ANormalF v e
pattern $mAKon :: forall {r} {v} {e}.
ANormalF v e -> (v -> [v] -> r) -> ((# #) -> r) -> r
$bAKon :: forall v e. v -> [v] -> ANormalF v e
AKon v args = AApp (FCont v) args
pattern TKon ::
(ABT.Var v) =>
v ->
[v] ->
ABTN.Term ANormalF v
pattern $mTKon :: forall {r} {v}.
Var v =>
Term ANormalF v -> (v -> [v] -> r) -> ((# #) -> r) -> r
$bTKon :: forall v. Var v => v -> [v] -> Term ANormalF v
TKon v args = TApp (FCont v) args
pattern AReq :: Reference -> CTag -> [v] -> ANormalF v e
pattern $mAReq :: forall {r} {v} {e}.
ANormalF v e
-> (Reference -> CTag -> [v] -> r) -> ((# #) -> r) -> r
$bAReq :: forall v e. Reference -> CTag -> [v] -> ANormalF v e
AReq r t args = AApp (FReq r t) args
pattern TReq ::
(ABT.Var v) =>
Reference ->
CTag ->
[v] ->
ABTN.Term ANormalF v
pattern $mTReq :: forall {r} {v}.
Var v =>
Term ANormalF v
-> (Reference -> CTag -> [v] -> r) -> ((# #) -> r) -> r
$bTReq :: forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TReq r t args = TApp (FReq r t) args
pattern APrm :: POp -> [v] -> ANormalF v e
pattern $mAPrm :: forall {r} {v} {e}.
ANormalF v e -> (POp -> [v] -> r) -> ((# #) -> r) -> r
$bAPrm :: forall v e. POp -> [v] -> ANormalF v e
APrm p args = AApp (FPrim (Left p)) args
pattern TPrm ::
(ABT.Var v) =>
POp ->
[v] ->
ABTN.Term ANormalF v
pattern $mTPrm :: forall {r} {v}.
Var v =>
Term ANormalF v -> (POp -> [v] -> r) -> ((# #) -> r) -> r
$bTPrm :: forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm p args = TApp (FPrim (Left p)) args
pattern AFOp :: FOp -> [v] -> ANormalF v e
pattern $mAFOp :: forall {r} {v} {e}.
ANormalF v e -> (Word64 -> [v] -> r) -> ((# #) -> r) -> r
$bAFOp :: forall v e. Word64 -> [v] -> ANormalF v e
AFOp p args = AApp (FPrim (Right p)) args
pattern TFOp ::
(ABT.Var v) =>
FOp ->
[v] ->
ABTN.Term ANormalF v
pattern $mTFOp :: forall {r} {v}.
Var v =>
Term ANormalF v -> (Word64 -> [v] -> r) -> ((# #) -> r) -> r
$bTFOp :: forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp p args = TApp (FPrim (Right p)) args
pattern THnd ::
(ABT.Var v) =>
[Reference] ->
v ->
ABTN.Term ANormalF v ->
ABTN.Term ANormalF v
pattern $mTHnd :: forall {r} {v}.
Var v =>
Term ANormalF v
-> ([Reference] -> v -> Term ANormalF v -> r) -> ((# #) -> r) -> r
$bTHnd :: forall v.
Var v =>
[Reference] -> v -> Term ANormalF v -> Term ANormalF v
THnd rs h b = ABTN.TTm (AHnd rs h b)
pattern TShift ::
(ABT.Var v) =>
Reference ->
v ->
ABTN.Term ANormalF v ->
ABTN.Term ANormalF v
pattern $mTShift :: forall {r} {v}.
Var v =>
Term ANormalF v
-> (Reference -> v -> Term ANormalF v -> r) -> ((# #) -> r) -> r
$bTShift :: forall v.
Var v =>
Reference -> v -> Term ANormalF v -> Term ANormalF v
TShift i v e = ABTN.TTm (AShift i (ABTN.TAbs v e))
pattern TMatch ::
(ABT.Var v) =>
v ->
Branched (ABTN.Term ANormalF v) ->
ABTN.Term ANormalF v
pattern $mTMatch :: forall {r} {v}.
Var v =>
Term ANormalF v
-> (v -> Branched (Term ANormalF v) -> r) -> ((# #) -> r) -> r
$bTMatch :: forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v cs = ABTN.TTm (AMatch v cs)
pattern TFrc :: (ABT.Var v) => v -> ABTN.Term ANormalF v
pattern $mTFrc :: forall {r} {v}.
Var v =>
Term ANormalF v -> (v -> r) -> ((# #) -> r) -> r
$bTFrc :: forall v. Var v => v -> Term ANormalF v
TFrc v = ABTN.TTm (AFrc v)
pattern TVar :: (ABT.Var v) => v -> ABTN.Term ANormalF v
pattern $mTVar :: forall {r} {v}.
Var v =>
Term ANormalF v -> (v -> r) -> ((# #) -> r) -> r
$bTVar :: forall v. Var v => v -> Term ANormalF v
TVar v = ABTN.TTm (AVar v)
{-# COMPLETE TLet, TName, TVar, TApp, TFrc, TLit, THnd, TShift, TMatch #-}
{-# COMPLETE
TLet,
TName,
TVar,
TFrc,
TApv,
TCom,
TCon,
TKon,
TReq,
TPrm,
TFOp,
TLit,
THnd,
TShift,
TMatch
#-}
bind :: (Var v) => Cte v -> ANormal v -> ANormal v
bind :: forall v. Var v => Cte v -> ANormal v -> ANormal v
bind (ST Direction Word16
d [v]
us [Mem]
ms ANormal v
bu) = Direction Word16
-> [v] -> [Mem] -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
Direction Word16
-> [v]
-> [Mem]
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
TLets Direction Word16
d [v]
us [Mem]
ms ANormal v
bu
bind (LZ v
u Either Reference v
f [v]
as) = v -> Either Reference v -> [v] -> ANormal v -> ANormal v
forall v.
Var v =>
v
-> Either Reference v -> [v] -> Term ANormalF v -> Term ANormalF v
TName v
u Either Reference v
f [v]
as
unbind :: (Var v) => ANormal v -> Maybe (Cte v, ANormal v)
unbind :: forall v. Var v => ANormal v -> Maybe (Cte v, ANormal v)
unbind (TLets Direction Word16
d [v]
us [Mem]
ms Term ANormalF v
bu Term ANormalF v
bd) = (Cte v, Term ANormalF v) -> Maybe (Cte v, Term ANormalF v)
forall a. a -> Maybe a
Just (Direction Word16 -> [v] -> [Mem] -> Term ANormalF v -> Cte v
forall v s. Direction Word16 -> [v] -> [Mem] -> s -> CTE v s
ST Direction Word16
d [v]
us [Mem]
ms Term ANormalF v
bu, Term ANormalF v
bd)
unbind (TName v
u Either Reference v
f [v]
as Term ANormalF v
bd) = (Cte v, Term ANormalF v) -> Maybe (Cte v, Term ANormalF v)
forall a. a -> Maybe a
Just (v -> Either Reference v -> [v] -> Cte v
forall v s. v -> Either Reference v -> [v] -> CTE v s
LZ v
u Either Reference v
f [v]
as, Term ANormalF v
bd)
unbind Term ANormalF v
_ = Maybe (Cte v, Term ANormalF v)
forall a. Maybe a
Nothing
unbinds :: (Var v) => ANormal v -> ([Cte v], ANormal v)
unbinds :: forall v. Var v => ANormal v -> ([Cte v], ANormal v)
unbinds (TLets Direction Word16
d [v]
us [Mem]
ms Term ANormalF v
bu (Term ANormalF v -> ([Cte v], Term ANormalF v)
forall v. Var v => ANormal v -> ([Cte v], ANormal v)
unbinds -> ([Cte v]
ctx, Term ANormalF v
bd))) =
(Direction Word16 -> [v] -> [Mem] -> Term ANormalF v -> Cte v
forall v s. Direction Word16 -> [v] -> [Mem] -> s -> CTE v s
ST Direction Word16
d [v]
us [Mem]
ms Term ANormalF v
bu Cte v -> [Cte v] -> [Cte v]
forall a. a -> [a] -> [a]
: [Cte v]
ctx, Term ANormalF v
bd)
unbinds (TName v
u Either Reference v
f [v]
as (Term ANormalF v -> ([Cte v], Term ANormalF v)
forall v. Var v => ANormal v -> ([Cte v], ANormal v)
unbinds -> ([Cte v]
ctx, Term ANormalF v
bd))) = (v -> Either Reference v -> [v] -> Cte v
forall v s. v -> Either Reference v -> [v] -> CTE v s
LZ v
u Either Reference v
f [v]
as Cte v -> [Cte v] -> [Cte v]
forall a. a -> [a] -> [a]
: [Cte v]
ctx, Term ANormalF v
bd)
unbinds Term ANormalF v
tm = ([], Term ANormalF v
tm)
pattern TBind ::
(Var v) =>
Cte v ->
ANormal v ->
ANormal v
pattern $mTBind :: forall {r} {v}.
Var v =>
ANormal v -> (Cte v -> ANormal v -> r) -> ((# #) -> r) -> r
$bTBind :: forall v. Var v => Cte v -> ANormal v -> ANormal v
TBind bn bd <-
(unbind -> Just (bn, bd))
where
TBind Cte v
bn ANormal v
bd = Cte v -> ANormal v -> ANormal v
forall v. Var v => Cte v -> ANormal v -> ANormal v
bind Cte v
bn ANormal v
bd
pattern TBinds :: (Var v) => [Cte v] -> ANormal v -> ANormal v
pattern $mTBinds :: forall {r} {v}.
Var v =>
ANormal v -> ([Cte v] -> ANormal v -> r) -> ((# #) -> r) -> r
$bTBinds :: forall v. Var v => [Cte v] -> ANormal v -> ANormal v
TBinds ctx bd <-
(unbinds -> (ctx, bd))
where
TBinds [Cte v]
ctx ANormal v
bd = (Cte v -> ANormal v -> ANormal v)
-> ANormal v -> [Cte v] -> ANormal v
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Cte v -> ANormal v -> ANormal v
forall v. Var v => Cte v -> ANormal v -> ANormal v
bind ANormal v
bd [Cte v]
ctx
{-# COMPLETE TBinds #-}
data SeqEnd = SLeft | SRight
deriving (SeqEnd -> SeqEnd -> Bool
(SeqEnd -> SeqEnd -> Bool)
-> (SeqEnd -> SeqEnd -> Bool) -> Eq SeqEnd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SeqEnd -> SeqEnd -> Bool
== :: SeqEnd -> SeqEnd -> Bool
$c/= :: SeqEnd -> SeqEnd -> Bool
/= :: SeqEnd -> SeqEnd -> Bool
Eq, Eq SeqEnd
Eq SeqEnd =>
(SeqEnd -> SeqEnd -> Ordering)
-> (SeqEnd -> SeqEnd -> Bool)
-> (SeqEnd -> SeqEnd -> Bool)
-> (SeqEnd -> SeqEnd -> Bool)
-> (SeqEnd -> SeqEnd -> Bool)
-> (SeqEnd -> SeqEnd -> SeqEnd)
-> (SeqEnd -> SeqEnd -> SeqEnd)
-> Ord SeqEnd
SeqEnd -> SeqEnd -> Bool
SeqEnd -> SeqEnd -> Ordering
SeqEnd -> SeqEnd -> SeqEnd
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
$ccompare :: SeqEnd -> SeqEnd -> Ordering
compare :: SeqEnd -> SeqEnd -> Ordering
$c< :: SeqEnd -> SeqEnd -> Bool
< :: SeqEnd -> SeqEnd -> Bool
$c<= :: SeqEnd -> SeqEnd -> Bool
<= :: SeqEnd -> SeqEnd -> Bool
$c> :: SeqEnd -> SeqEnd -> Bool
> :: SeqEnd -> SeqEnd -> Bool
$c>= :: SeqEnd -> SeqEnd -> Bool
>= :: SeqEnd -> SeqEnd -> Bool
$cmax :: SeqEnd -> SeqEnd -> SeqEnd
max :: SeqEnd -> SeqEnd -> SeqEnd
$cmin :: SeqEnd -> SeqEnd -> SeqEnd
min :: SeqEnd -> SeqEnd -> SeqEnd
Ord, Int -> SeqEnd
SeqEnd -> Int
SeqEnd -> [SeqEnd]
SeqEnd -> SeqEnd
SeqEnd -> SeqEnd -> [SeqEnd]
SeqEnd -> SeqEnd -> SeqEnd -> [SeqEnd]
(SeqEnd -> SeqEnd)
-> (SeqEnd -> SeqEnd)
-> (Int -> SeqEnd)
-> (SeqEnd -> Int)
-> (SeqEnd -> [SeqEnd])
-> (SeqEnd -> SeqEnd -> [SeqEnd])
-> (SeqEnd -> SeqEnd -> [SeqEnd])
-> (SeqEnd -> SeqEnd -> SeqEnd -> [SeqEnd])
-> Enum SeqEnd
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SeqEnd -> SeqEnd
succ :: SeqEnd -> SeqEnd
$cpred :: SeqEnd -> SeqEnd
pred :: SeqEnd -> SeqEnd
$ctoEnum :: Int -> SeqEnd
toEnum :: Int -> SeqEnd
$cfromEnum :: SeqEnd -> Int
fromEnum :: SeqEnd -> Int
$cenumFrom :: SeqEnd -> [SeqEnd]
enumFrom :: SeqEnd -> [SeqEnd]
$cenumFromThen :: SeqEnd -> SeqEnd -> [SeqEnd]
enumFromThen :: SeqEnd -> SeqEnd -> [SeqEnd]
$cenumFromTo :: SeqEnd -> SeqEnd -> [SeqEnd]
enumFromTo :: SeqEnd -> SeqEnd -> [SeqEnd]
$cenumFromThenTo :: SeqEnd -> SeqEnd -> SeqEnd -> [SeqEnd]
enumFromThenTo :: SeqEnd -> SeqEnd -> SeqEnd -> [SeqEnd]
Enum, Int -> SeqEnd -> ShowS
[SeqEnd] -> ShowS
SeqEnd -> String
(Int -> SeqEnd -> ShowS)
-> (SeqEnd -> String) -> ([SeqEnd] -> ShowS) -> Show SeqEnd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SeqEnd -> ShowS
showsPrec :: Int -> SeqEnd -> ShowS
$cshow :: SeqEnd -> String
show :: SeqEnd -> String
$cshowList :: [SeqEnd] -> ShowS
showList :: [SeqEnd] -> ShowS
Show)
data Branched e
= MatchIntegral (EnumMap Word64 e) (Maybe e)
| MatchText (Map.Map Util.Text.Text e) (Maybe e)
| MatchRequest (Map Reference (EnumMap CTag ([Mem], e))) e
| MatchEmpty
| MatchData Reference (EnumMap CTag ([Mem], e)) (Maybe e)
| MatchSum (EnumMap Word64 ([Mem], e))
| MatchNumeric Reference (EnumMap Word64 e) (Maybe e)
deriving (Int -> Branched e -> ShowS
[Branched e] -> ShowS
Branched e -> String
(Int -> Branched e -> ShowS)
-> (Branched e -> String)
-> ([Branched e] -> ShowS)
-> Show (Branched e)
forall e. Show e => Int -> Branched e -> ShowS
forall e. Show e => [Branched e] -> ShowS
forall e. Show e => Branched e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> Branched e -> ShowS
showsPrec :: Int -> Branched e -> ShowS
$cshow :: forall e. Show e => Branched e -> String
show :: Branched e -> String
$cshowList :: forall e. Show e => [Branched e] -> ShowS
showList :: [Branched e] -> ShowS
Show, Branched e -> Branched e -> Bool
(Branched e -> Branched e -> Bool)
-> (Branched e -> Branched e -> Bool) -> Eq (Branched e)
forall e. Eq e => Branched e -> Branched e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => Branched e -> Branched e -> Bool
== :: Branched e -> Branched e -> Bool
$c/= :: forall e. Eq e => Branched e -> Branched e -> Bool
/= :: Branched e -> Branched e -> Bool
Eq, (forall a b. (a -> b) -> Branched a -> Branched b)
-> (forall a b. a -> Branched b -> Branched a) -> Functor Branched
forall a b. a -> Branched b -> Branched a
forall a b. (a -> b) -> Branched a -> Branched b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Branched a -> Branched b
fmap :: forall a b. (a -> b) -> Branched a -> Branched b
$c<$ :: forall a b. a -> Branched b -> Branched a
<$ :: forall a b. a -> Branched b -> Branched a
Functor, (forall m. Monoid m => Branched m -> m)
-> (forall m a. Monoid m => (a -> m) -> Branched a -> m)
-> (forall m a. Monoid m => (a -> m) -> Branched a -> m)
-> (forall a b. (a -> b -> b) -> b -> Branched a -> b)
-> (forall a b. (a -> b -> b) -> b -> Branched a -> b)
-> (forall b a. (b -> a -> b) -> b -> Branched a -> b)
-> (forall b a. (b -> a -> b) -> b -> Branched a -> b)
-> (forall a. (a -> a -> a) -> Branched a -> a)
-> (forall a. (a -> a -> a) -> Branched a -> a)
-> (forall a. Branched a -> [a])
-> (forall a. Branched a -> Bool)
-> (forall a. Branched a -> Int)
-> (forall a. Eq a => a -> Branched a -> Bool)
-> (forall a. Ord a => Branched a -> a)
-> (forall a. Ord a => Branched a -> a)
-> (forall a. Num a => Branched a -> a)
-> (forall a. Num a => Branched a -> a)
-> Foldable Branched
forall a. Eq a => a -> Branched a -> Bool
forall a. Num a => Branched a -> a
forall a. Ord a => Branched a -> a
forall m. Monoid m => Branched m -> m
forall a. Branched a -> Bool
forall a. Branched a -> Int
forall a. Branched a -> [a]
forall a. (a -> a -> a) -> Branched a -> a
forall m a. Monoid m => (a -> m) -> Branched a -> m
forall b a. (b -> a -> b) -> b -> Branched a -> b
forall a b. (a -> b -> b) -> b -> Branched 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
$cfold :: forall m. Monoid m => Branched m -> m
fold :: forall m. Monoid m => Branched m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Branched a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Branched a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Branched a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Branched a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Branched a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Branched a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Branched a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Branched a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Branched a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Branched a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Branched a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Branched a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Branched a -> a
foldr1 :: forall a. (a -> a -> a) -> Branched a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Branched a -> a
foldl1 :: forall a. (a -> a -> a) -> Branched a -> a
$ctoList :: forall a. Branched a -> [a]
toList :: forall a. Branched a -> [a]
$cnull :: forall a. Branched a -> Bool
null :: forall a. Branched a -> Bool
$clength :: forall a. Branched a -> Int
length :: forall a. Branched a -> Int
$celem :: forall a. Eq a => a -> Branched a -> Bool
elem :: forall a. Eq a => a -> Branched a -> Bool
$cmaximum :: forall a. Ord a => Branched a -> a
maximum :: forall a. Ord a => Branched a -> a
$cminimum :: forall a. Ord a => Branched a -> a
minimum :: forall a. Ord a => Branched a -> a
$csum :: forall a. Num a => Branched a -> a
sum :: forall a. Num a => Branched a -> a
$cproduct :: forall a. Num a => Branched a -> a
product :: forall a. Num a => Branched a -> a
Foldable, Functor Branched
Foldable Branched
(Functor Branched, Foldable Branched) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Branched a -> f (Branched b))
-> (forall (f :: * -> *) a.
Applicative f =>
Branched (f a) -> f (Branched a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Branched a -> m (Branched b))
-> (forall (m :: * -> *) a.
Monad m =>
Branched (m a) -> m (Branched a))
-> Traversable Branched
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 => Branched (m a) -> m (Branched a)
forall (f :: * -> *) a.
Applicative f =>
Branched (f a) -> f (Branched a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Branched a -> m (Branched b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Branched a -> f (Branched b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Branched a -> f (Branched b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Branched a -> f (Branched b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Branched (f a) -> f (Branched a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Branched (f a) -> f (Branched a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Branched a -> m (Branched b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Branched a -> m (Branched b)
$csequence :: forall (m :: * -> *) a. Monad m => Branched (m a) -> m (Branched a)
sequence :: forall (m :: * -> *) a. Monad m => Branched (m a) -> m (Branched a)
Traversable)
pattern MatchDataCover :: Reference -> EnumMap CTag ([Mem], e) -> Branched e
pattern $mMatchDataCover :: forall {r} {e}.
Branched e
-> (Reference -> EnumMap CTag ([Mem], e) -> r) -> ((# #) -> r) -> r
$bMatchDataCover :: forall e. Reference -> EnumMap CTag ([Mem], e) -> Branched e
MatchDataCover r m = MatchData r m Nothing
data BranchAccum v
= AccumEmpty
| AccumIntegral
Reference
(Maybe (ANormal v))
(EnumMap Word64 (ANormal v))
| AccumText
(Maybe (ANormal v))
(Map.Map Util.Text.Text (ANormal v))
| AccumDefault (ANormal v)
| AccumPure (ANormal v)
| AccumRequest
(Map Reference (EnumMap CTag ([Mem], ANormal v)))
(Maybe (ANormal v))
| AccumData
Reference
(Maybe (ANormal v))
(EnumMap CTag ([Mem], ANormal v))
| AccumSeqEmpty (ANormal v)
| AccumSeqView
SeqEnd
(Maybe (ANormal v))
(ANormal v)
| AccumSeqSplit
SeqEnd
Int
(Maybe (ANormal v))
(ANormal v)
instance Semigroup (BranchAccum v) where
BranchAccum v
AccumEmpty <> :: BranchAccum v -> BranchAccum v -> BranchAccum v
<> BranchAccum v
r = BranchAccum v
r
BranchAccum v
l <> BranchAccum v
AccumEmpty = BranchAccum v
l
AccumIntegral Reference
rl Maybe (ANormal v)
dl EnumMap Word64 (ANormal v)
cl <> AccumIntegral Reference
rr Maybe (ANormal v)
dr EnumMap Word64 (ANormal v)
cr
| Reference
rl Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
rr = Reference
-> Maybe (ANormal v) -> EnumMap Word64 (ANormal v) -> BranchAccum v
forall v.
Reference
-> Maybe (ANormal v) -> EnumMap Word64 (ANormal v) -> BranchAccum v
AccumIntegral Reference
rl (Maybe (ANormal v)
dl Maybe (ANormal v) -> Maybe (ANormal v) -> Maybe (ANormal v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal v)
dr) (EnumMap Word64 (ANormal v) -> BranchAccum v)
-> EnumMap Word64 (ANormal v) -> BranchAccum v
forall a b. (a -> b) -> a -> b
$ EnumMap Word64 (ANormal v)
cl EnumMap Word64 (ANormal v)
-> EnumMap Word64 (ANormal v) -> EnumMap Word64 (ANormal v)
forall a. Semigroup a => a -> a -> a
<> EnumMap Word64 (ANormal v)
cr
AccumText Maybe (ANormal v)
dl Map Text (ANormal v)
cl <> AccumText Maybe (ANormal v)
dr Map Text (ANormal v)
cr =
Maybe (ANormal v) -> Map Text (ANormal v) -> BranchAccum v
forall v.
Maybe (ANormal v) -> Map Text (ANormal v) -> BranchAccum v
AccumText (Maybe (ANormal v)
dl Maybe (ANormal v) -> Maybe (ANormal v) -> Maybe (ANormal v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal v)
dr) (Map Text (ANormal v)
cl Map Text (ANormal v)
-> Map Text (ANormal v) -> Map Text (ANormal v)
forall a. Semigroup a => a -> a -> a
<> Map Text (ANormal v)
cr)
AccumData Reference
rl Maybe (ANormal v)
dl EnumMap CTag ([Mem], ANormal v)
cl <> AccumData Reference
rr Maybe (ANormal v)
dr EnumMap CTag ([Mem], ANormal v)
cr
| Reference
rl Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
rr = Reference
-> Maybe (ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> BranchAccum v
forall v.
Reference
-> Maybe (ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> BranchAccum v
AccumData Reference
rl (Maybe (ANormal v)
dl Maybe (ANormal v) -> Maybe (ANormal v) -> Maybe (ANormal v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal v)
dr) (EnumMap CTag ([Mem], ANormal v)
cl EnumMap CTag ([Mem], ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
forall a. Semigroup a => a -> a -> a
<> EnumMap CTag ([Mem], ANormal v)
cr)
AccumDefault ANormal v
dl <> AccumIntegral Reference
r Maybe (ANormal v)
_ EnumMap Word64 (ANormal v)
cr =
Reference
-> Maybe (ANormal v) -> EnumMap Word64 (ANormal v) -> BranchAccum v
forall v.
Reference
-> Maybe (ANormal v) -> EnumMap Word64 (ANormal v) -> BranchAccum v
AccumIntegral Reference
r (ANormal v -> Maybe (ANormal v)
forall a. a -> Maybe a
Just ANormal v
dl) EnumMap Word64 (ANormal v)
cr
AccumDefault ANormal v
dl <> AccumText Maybe (ANormal v)
_ Map Text (ANormal v)
cr =
Maybe (ANormal v) -> Map Text (ANormal v) -> BranchAccum v
forall v.
Maybe (ANormal v) -> Map Text (ANormal v) -> BranchAccum v
AccumText (ANormal v -> Maybe (ANormal v)
forall a. a -> Maybe a
Just ANormal v
dl) Map Text (ANormal v)
cr
AccumDefault ANormal v
dl <> AccumData Reference
rr Maybe (ANormal v)
_ EnumMap CTag ([Mem], ANormal v)
cr =
Reference
-> Maybe (ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> BranchAccum v
forall v.
Reference
-> Maybe (ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> BranchAccum v
AccumData Reference
rr (ANormal v -> Maybe (ANormal v)
forall a. a -> Maybe a
Just ANormal v
dl) EnumMap CTag ([Mem], ANormal v)
cr
AccumIntegral Reference
r Maybe (ANormal v)
dl EnumMap Word64 (ANormal v)
cl <> AccumDefault ANormal v
dr =
Reference
-> Maybe (ANormal v) -> EnumMap Word64 (ANormal v) -> BranchAccum v
forall v.
Reference
-> Maybe (ANormal v) -> EnumMap Word64 (ANormal v) -> BranchAccum v
AccumIntegral Reference
r (Maybe (ANormal v)
dl Maybe (ANormal v) -> Maybe (ANormal v) -> Maybe (ANormal v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal v -> Maybe (ANormal v)
forall a. a -> Maybe a
Just ANormal v
dr) EnumMap Word64 (ANormal v)
cl
AccumText Maybe (ANormal v)
dl Map Text (ANormal v)
cl <> AccumDefault ANormal v
dr =
Maybe (ANormal v) -> Map Text (ANormal v) -> BranchAccum v
forall v.
Maybe (ANormal v) -> Map Text (ANormal v) -> BranchAccum v
AccumText (Maybe (ANormal v)
dl Maybe (ANormal v) -> Maybe (ANormal v) -> Maybe (ANormal v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal v -> Maybe (ANormal v)
forall a. a -> Maybe a
Just ANormal v
dr) Map Text (ANormal v)
cl
AccumData Reference
rl Maybe (ANormal v)
dl EnumMap CTag ([Mem], ANormal v)
cl <> AccumDefault ANormal v
dr =
Reference
-> Maybe (ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> BranchAccum v
forall v.
Reference
-> Maybe (ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> BranchAccum v
AccumData Reference
rl (Maybe (ANormal v)
dl Maybe (ANormal v) -> Maybe (ANormal v) -> Maybe (ANormal v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal v -> Maybe (ANormal v)
forall a. a -> Maybe a
Just ANormal v
dr) EnumMap CTag ([Mem], ANormal v)
cl
l :: BranchAccum v
l@(AccumPure ANormal v
_) <> AccumPure ANormal v
_ = BranchAccum v
l
AccumPure ANormal v
dl <> AccumRequest Map Reference (EnumMap CTag ([Mem], ANormal v))
hr Maybe (ANormal v)
_ = Map Reference (EnumMap CTag ([Mem], ANormal v))
-> Maybe (ANormal v) -> BranchAccum v
forall v.
Map Reference (EnumMap CTag ([Mem], ANormal v))
-> Maybe (ANormal v) -> BranchAccum v
AccumRequest Map Reference (EnumMap CTag ([Mem], ANormal v))
hr (ANormal v -> Maybe (ANormal v)
forall a. a -> Maybe a
Just ANormal v
dl)
AccumRequest Map Reference (EnumMap CTag ([Mem], ANormal v))
hl Maybe (ANormal v)
dl <> AccumPure ANormal v
dr =
Map Reference (EnumMap CTag ([Mem], ANormal v))
-> Maybe (ANormal v) -> BranchAccum v
forall v.
Map Reference (EnumMap CTag ([Mem], ANormal v))
-> Maybe (ANormal v) -> BranchAccum v
AccumRequest Map Reference (EnumMap CTag ([Mem], ANormal v))
hl (Maybe (ANormal v)
dl Maybe (ANormal v) -> Maybe (ANormal v) -> Maybe (ANormal v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal v -> Maybe (ANormal v)
forall a. a -> Maybe a
Just ANormal v
dr)
AccumRequest Map Reference (EnumMap CTag ([Mem], ANormal v))
hl Maybe (ANormal v)
dl <> AccumRequest Map Reference (EnumMap CTag ([Mem], ANormal v))
hr Maybe (ANormal v)
dr =
Map Reference (EnumMap CTag ([Mem], ANormal v))
-> Maybe (ANormal v) -> BranchAccum v
forall v.
Map Reference (EnumMap CTag ([Mem], ANormal v))
-> Maybe (ANormal v) -> BranchAccum v
AccumRequest Map Reference (EnumMap CTag ([Mem], ANormal v))
hm (Maybe (ANormal v) -> BranchAccum v)
-> Maybe (ANormal v) -> BranchAccum v
forall a b. (a -> b) -> a -> b
$ Maybe (ANormal v)
dl Maybe (ANormal v) -> Maybe (ANormal v) -> Maybe (ANormal v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal v)
dr
where
hm :: Map Reference (EnumMap CTag ([Mem], ANormal v))
hm = (EnumMap CTag ([Mem], ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> EnumMap CTag ([Mem], ANormal v))
-> Map Reference (EnumMap CTag ([Mem], ANormal v))
-> Map Reference (EnumMap CTag ([Mem], ANormal v))
-> Map Reference (EnumMap CTag ([Mem], ANormal v))
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith EnumMap CTag ([Mem], ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
forall a. Semigroup a => a -> a -> a
(<>) Map Reference (EnumMap CTag ([Mem], ANormal v))
hl Map Reference (EnumMap CTag ([Mem], ANormal v))
hr
l :: BranchAccum v
l@(AccumSeqEmpty ANormal v
_) <> AccumSeqEmpty ANormal v
_ = BranchAccum v
l
AccumSeqEmpty ANormal v
eml <> AccumSeqView SeqEnd
er Maybe (ANormal v)
_ ANormal v
cnr =
SeqEnd -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
forall v. SeqEnd -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
AccumSeqView SeqEnd
er (ANormal v -> Maybe (ANormal v)
forall a. a -> Maybe a
Just ANormal v
eml) ANormal v
cnr
AccumSeqView SeqEnd
el Maybe (ANormal v)
eml ANormal v
cnl <> AccumSeqEmpty ANormal v
emr =
SeqEnd -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
forall v. SeqEnd -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
AccumSeqView SeqEnd
el (Maybe (ANormal v)
eml Maybe (ANormal v) -> Maybe (ANormal v) -> Maybe (ANormal v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal v -> Maybe (ANormal v)
forall a. a -> Maybe a
Just ANormal v
emr) ANormal v
cnl
AccumSeqView SeqEnd
el Maybe (ANormal v)
eml ANormal v
cnl <> AccumSeqView SeqEnd
er Maybe (ANormal v)
emr ANormal v
_
| SeqEnd
el SeqEnd -> SeqEnd -> Bool
forall a. Eq a => a -> a -> Bool
/= SeqEnd
er =
String -> BranchAccum v
forall a. HasCallStack => String -> a
internalBug String
"AccumSeqView: trying to merge views of opposite ends"
| Bool
otherwise = SeqEnd -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
forall v. SeqEnd -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
AccumSeqView SeqEnd
el (Maybe (ANormal v)
eml Maybe (ANormal v) -> Maybe (ANormal v) -> Maybe (ANormal v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal v)
emr) ANormal v
cnl
AccumSeqView SeqEnd
_ Maybe (ANormal v)
_ ANormal v
_ <> AccumDefault ANormal v
_ =
String -> BranchAccum v
forall a. HasCallStack => String -> a
internalBug String
"seq views may not have defaults"
AccumDefault ANormal v
_ <> AccumSeqView SeqEnd
_ Maybe (ANormal v)
_ ANormal v
_ =
String -> BranchAccum v
forall a. HasCallStack => String -> a
internalBug String
"seq views may not have defaults"
AccumSeqSplit SeqEnd
el Int
nl Maybe (ANormal v)
dl ANormal v
bl <> AccumSeqSplit SeqEnd
er Int
nr Maybe (ANormal v)
dr ANormal v
_
| SeqEnd
el SeqEnd -> SeqEnd -> Bool
forall a. Eq a => a -> a -> Bool
/= SeqEnd
er =
String -> BranchAccum v
forall a. HasCallStack => String -> a
internalBug
String
"AccumSeqSplit: trying to merge splits at opposite ends"
| Int
nl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nr =
String -> BranchAccum v
forall a. HasCallStack => String -> a
internalBug
String
"AccumSeqSplit: trying to merge splits at different positions"
| Bool
otherwise =
SeqEnd -> Int -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
forall v.
SeqEnd -> Int -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
AccumSeqSplit SeqEnd
el Int
nl (Maybe (ANormal v)
dl Maybe (ANormal v) -> Maybe (ANormal v) -> Maybe (ANormal v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal v)
dr) ANormal v
bl
AccumDefault ANormal v
dl <> AccumSeqSplit SeqEnd
er Int
nr Maybe (ANormal v)
_ ANormal v
br =
SeqEnd -> Int -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
forall v.
SeqEnd -> Int -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
AccumSeqSplit SeqEnd
er Int
nr (ANormal v -> Maybe (ANormal v)
forall a. a -> Maybe a
Just ANormal v
dl) ANormal v
br
AccumSeqSplit SeqEnd
el Int
nl Maybe (ANormal v)
dl ANormal v
bl <> AccumDefault ANormal v
dr =
SeqEnd -> Int -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
forall v.
SeqEnd -> Int -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
AccumSeqSplit SeqEnd
el Int
nl (Maybe (ANormal v)
dl Maybe (ANormal v) -> Maybe (ANormal v) -> Maybe (ANormal v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal v -> Maybe (ANormal v)
forall a. a -> Maybe a
Just ANormal v
dr) ANormal v
bl
BranchAccum v
_ <> BranchAccum v
_ = String -> BranchAccum v
forall a. HasCallStack => String -> a
internalBug (String -> BranchAccum v) -> String -> BranchAccum v
forall a b. (a -> b) -> a -> b
$ String
"cannot merge data cases for different types"
instance Monoid (BranchAccum e) where
mempty :: BranchAccum e
mempty = BranchAccum e
forall e. BranchAccum e
AccumEmpty
type FOp = Word64
data Func v
=
FVar v
|
FComb !Reference
|
FCont v
|
FCon !Reference !CTag
|
FReq !Reference !CTag
|
FPrim (Either POp FOp)
deriving (Int -> Func v -> ShowS
[Func v] -> ShowS
Func v -> String
(Int -> Func v -> ShowS)
-> (Func v -> String) -> ([Func v] -> ShowS) -> Show (Func v)
forall v. Show v => Int -> Func v -> ShowS
forall v. Show v => [Func v] -> ShowS
forall v. Show v => Func v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> Func v -> ShowS
showsPrec :: Int -> Func v -> ShowS
$cshow :: forall v. Show v => Func v -> String
show :: Func v -> String
$cshowList :: forall v. Show v => [Func v] -> ShowS
showList :: [Func v] -> ShowS
Show, Func v -> Func v -> Bool
(Func v -> Func v -> Bool)
-> (Func v -> Func v -> Bool) -> Eq (Func v)
forall v. Eq v => Func v -> Func v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => Func v -> Func v -> Bool
== :: Func v -> Func v -> Bool
$c/= :: forall v. Eq v => Func v -> Func v -> Bool
/= :: Func v -> Func v -> Bool
Eq, (forall a b. (a -> b) -> Func a -> Func b)
-> (forall a b. a -> Func b -> Func a) -> Functor Func
forall a b. a -> Func b -> Func a
forall a b. (a -> b) -> Func a -> Func b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Func a -> Func b
fmap :: forall a b. (a -> b) -> Func a -> Func b
$c<$ :: forall a b. a -> Func b -> Func a
<$ :: forall a b. a -> Func b -> Func a
Functor, (forall m. Monoid m => Func m -> m)
-> (forall m a. Monoid m => (a -> m) -> Func a -> m)
-> (forall m a. Monoid m => (a -> m) -> Func a -> m)
-> (forall a b. (a -> b -> b) -> b -> Func a -> b)
-> (forall a b. (a -> b -> b) -> b -> Func a -> b)
-> (forall b a. (b -> a -> b) -> b -> Func a -> b)
-> (forall b a. (b -> a -> b) -> b -> Func a -> b)
-> (forall a. (a -> a -> a) -> Func a -> a)
-> (forall a. (a -> a -> a) -> Func a -> a)
-> (forall a. Func a -> [a])
-> (forall a. Func a -> Bool)
-> (forall a. Func a -> Int)
-> (forall a. Eq a => a -> Func a -> Bool)
-> (forall a. Ord a => Func a -> a)
-> (forall a. Ord a => Func a -> a)
-> (forall a. Num a => Func a -> a)
-> (forall a. Num a => Func a -> a)
-> Foldable Func
forall a. Eq a => a -> Func a -> Bool
forall a. Num a => Func a -> a
forall a. Ord a => Func a -> a
forall m. Monoid m => Func m -> m
forall a. Func a -> Bool
forall a. Func a -> Int
forall a. Func a -> [a]
forall a. (a -> a -> a) -> Func a -> a
forall m a. Monoid m => (a -> m) -> Func a -> m
forall b a. (b -> a -> b) -> b -> Func a -> b
forall a b. (a -> b -> b) -> b -> Func 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
$cfold :: forall m. Monoid m => Func m -> m
fold :: forall m. Monoid m => Func m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Func a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Func a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Func a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Func a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Func a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Func a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Func a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Func a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Func a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Func a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Func a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Func a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Func a -> a
foldr1 :: forall a. (a -> a -> a) -> Func a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Func a -> a
foldl1 :: forall a. (a -> a -> a) -> Func a -> a
$ctoList :: forall a. Func a -> [a]
toList :: forall a. Func a -> [a]
$cnull :: forall a. Func a -> Bool
null :: forall a. Func a -> Bool
$clength :: forall a. Func a -> Int
length :: forall a. Func a -> Int
$celem :: forall a. Eq a => a -> Func a -> Bool
elem :: forall a. Eq a => a -> Func a -> Bool
$cmaximum :: forall a. Ord a => Func a -> a
maximum :: forall a. Ord a => Func a -> a
$cminimum :: forall a. Ord a => Func a -> a
minimum :: forall a. Ord a => Func a -> a
$csum :: forall a. Num a => Func a -> a
sum :: forall a. Num a => Func a -> a
$cproduct :: forall a. Num a => Func a -> a
product :: forall a. Num a => Func a -> a
Foldable, Functor Func
Foldable Func
(Functor Func, Foldable Func) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Func a -> f (Func b))
-> (forall (f :: * -> *) a.
Applicative f =>
Func (f a) -> f (Func a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Func a -> m (Func b))
-> (forall (m :: * -> *) a. Monad m => Func (m a) -> m (Func a))
-> Traversable Func
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 => Func (m a) -> m (Func a)
forall (f :: * -> *) a. Applicative f => Func (f a) -> f (Func a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Func a -> m (Func b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Func a -> f (Func b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Func a -> f (Func b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Func a -> f (Func b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Func (f a) -> f (Func a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Func (f a) -> f (Func a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Func a -> m (Func b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Func a -> m (Func b)
$csequence :: forall (m :: * -> *) a. Monad m => Func (m a) -> m (Func a)
sequence :: forall (m :: * -> *) a. Monad m => Func (m a) -> m (Func a)
Traversable)
data Lit
= I Int64
| N Word64
| F Double
| T Util.Text.Text
| C Char
| LM Referent
| LY Reference
deriving (Int -> Lit -> ShowS
[Lit] -> ShowS
Lit -> String
(Int -> Lit -> ShowS)
-> (Lit -> String) -> ([Lit] -> ShowS) -> Show Lit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lit -> ShowS
showsPrec :: Int -> Lit -> ShowS
$cshow :: Lit -> String
show :: Lit -> String
$cshowList :: [Lit] -> ShowS
showList :: [Lit] -> ShowS
Show, Lit -> Lit -> Bool
(Lit -> Lit -> Bool) -> (Lit -> Lit -> Bool) -> Eq Lit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lit -> Lit -> Bool
== :: Lit -> Lit -> Bool
$c/= :: Lit -> Lit -> Bool
/= :: Lit -> Lit -> Bool
Eq)
litRef :: Lit -> Reference
litRef :: Lit -> Reference
litRef (I Int64
_) = Reference
Ty.intRef
litRef (N Word64
_) = Reference
Ty.natRef
litRef (F Double
_) = Reference
Ty.floatRef
litRef (T Text
_) = Reference
Ty.textRef
litRef (C Char
_) = Reference
Ty.charRef
litRef (LM Referent
_) = Reference
Ty.termLinkRef
litRef (LY Reference
_) = Reference
Ty.typeLinkRef
data POp
=
ADDI
| SUBI
| MULI
| DIVI
| SGNI
| NEGI
| MODI
| POWI
| SHLI
| SHRI
| INCI
| DECI
| LEQI
| EQLI
| ADDN
| SUBN
| MULN
| DIVN
| MODN
| TZRO
| LZRO
| POPC
| POWN
| SHLN
| SHRN
| ANDN
| IORN
| XORN
| COMN
| INCN
| DECN
| LEQN
| EQLN
| ADDF
| SUBF
| MULF
| DIVF
| MINF
| MAXF
| LEQF
| EQLF
| POWF
| EXPF
| SQRT
| LOGF
| LOGB
| ABSF
| CEIL
| FLOR
| TRNF
| RNDF
| COSF
| ACOS
| COSH
| ACSH
| SINF
| ASIN
| SINH
| ASNH
| TANF
| ATAN
| TANH
| ATNH
| ATN2
| CATT
| TAKT
| DRPT
| SIZT
| IXOT
| UCNS
| USNC
| EQLT
| LEQT
| PAKT
| UPKT
| CATS
| TAKS
| DRPS
| SIZS
| CONS
| SNOC
| IDXS
| BLDS
| VWLS
| VWRS
| SPLL
| SPLR
| PAKB
| UPKB
| TAKB
| DRPB
| IXOB
| IDXB
| SIZB
| FLTB
| CATB
| ITOF
| NTOF
| ITOT
| NTOT
| TTOI
| TTON
| TTOF
| FTOT
|
FORK
|
EQLU
| CMPU
| EROR
|
MISS
| CACH
| LKUP
| LOAD
| CVLD
| SDBX
| VALU
| TLTT
| PRNT
| INFO
| TRCE
| DBTX
|
ATOM
| TFRC
| SDBL
| SDBV
deriving (Int -> POp -> ShowS
[POp] -> ShowS
POp -> String
(Int -> POp -> ShowS)
-> (POp -> String) -> ([POp] -> ShowS) -> Show POp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> POp -> ShowS
showsPrec :: Int -> POp -> ShowS
$cshow :: POp -> String
show :: POp -> String
$cshowList :: [POp] -> ShowS
showList :: [POp] -> ShowS
Show, POp -> POp -> Bool
(POp -> POp -> Bool) -> (POp -> POp -> Bool) -> Eq POp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: POp -> POp -> Bool
== :: POp -> POp -> Bool
$c/= :: POp -> POp -> Bool
/= :: POp -> POp -> Bool
Eq, Eq POp
Eq POp =>
(POp -> POp -> Ordering)
-> (POp -> POp -> Bool)
-> (POp -> POp -> Bool)
-> (POp -> POp -> Bool)
-> (POp -> POp -> Bool)
-> (POp -> POp -> POp)
-> (POp -> POp -> POp)
-> Ord POp
POp -> POp -> Bool
POp -> POp -> Ordering
POp -> POp -> POp
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
$ccompare :: POp -> POp -> Ordering
compare :: POp -> POp -> Ordering
$c< :: POp -> POp -> Bool
< :: POp -> POp -> Bool
$c<= :: POp -> POp -> Bool
<= :: POp -> POp -> Bool
$c> :: POp -> POp -> Bool
> :: POp -> POp -> Bool
$c>= :: POp -> POp -> Bool
>= :: POp -> POp -> Bool
$cmax :: POp -> POp -> POp
max :: POp -> POp -> POp
$cmin :: POp -> POp -> POp
min :: POp -> POp -> POp
Ord, Int -> POp
POp -> Int
POp -> [POp]
POp -> POp
POp -> POp -> [POp]
POp -> POp -> POp -> [POp]
(POp -> POp)
-> (POp -> POp)
-> (Int -> POp)
-> (POp -> Int)
-> (POp -> [POp])
-> (POp -> POp -> [POp])
-> (POp -> POp -> [POp])
-> (POp -> POp -> POp -> [POp])
-> Enum POp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: POp -> POp
succ :: POp -> POp
$cpred :: POp -> POp
pred :: POp -> POp
$ctoEnum :: Int -> POp
toEnum :: Int -> POp
$cfromEnum :: POp -> Int
fromEnum :: POp -> Int
$cenumFrom :: POp -> [POp]
enumFrom :: POp -> [POp]
$cenumFromThen :: POp -> POp -> [POp]
enumFromThen :: POp -> POp -> [POp]
$cenumFromTo :: POp -> POp -> [POp]
enumFromTo :: POp -> POp -> [POp]
$cenumFromThenTo :: POp -> POp -> POp -> [POp]
enumFromThenTo :: POp -> POp -> POp -> [POp]
Enum, POp
POp -> POp -> Bounded POp
forall a. a -> a -> Bounded a
$cminBound :: POp
minBound :: POp
$cmaxBound :: POp
maxBound :: POp
Bounded)
type ANormal = ABTN.Term ANormalF
type Cte v = CTE v (ANormal v)
type Ctx v = Directed () [Cte v]
data Direction a = Indirect a | Direct
deriving (Direction a -> Direction a -> Bool
(Direction a -> Direction a -> Bool)
-> (Direction a -> Direction a -> Bool) -> Eq (Direction a)
forall a. Eq a => Direction a -> Direction a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Direction a -> Direction a -> Bool
== :: Direction a -> Direction a -> Bool
$c/= :: forall a. Eq a => Direction a -> Direction a -> Bool
/= :: Direction a -> Direction a -> Bool
Eq, Eq (Direction a)
Eq (Direction a) =>
(Direction a -> Direction a -> Ordering)
-> (Direction a -> Direction a -> Bool)
-> (Direction a -> Direction a -> Bool)
-> (Direction a -> Direction a -> Bool)
-> (Direction a -> Direction a -> Bool)
-> (Direction a -> Direction a -> Direction a)
-> (Direction a -> Direction a -> Direction a)
-> Ord (Direction a)
Direction a -> Direction a -> Bool
Direction a -> Direction a -> Ordering
Direction a -> Direction a -> Direction a
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 a. Ord a => Eq (Direction a)
forall a. Ord a => Direction a -> Direction a -> Bool
forall a. Ord a => Direction a -> Direction a -> Ordering
forall a. Ord a => Direction a -> Direction a -> Direction a
$ccompare :: forall a. Ord a => Direction a -> Direction a -> Ordering
compare :: Direction a -> Direction a -> Ordering
$c< :: forall a. Ord a => Direction a -> Direction a -> Bool
< :: Direction a -> Direction a -> Bool
$c<= :: forall a. Ord a => Direction a -> Direction a -> Bool
<= :: Direction a -> Direction a -> Bool
$c> :: forall a. Ord a => Direction a -> Direction a -> Bool
> :: Direction a -> Direction a -> Bool
$c>= :: forall a. Ord a => Direction a -> Direction a -> Bool
>= :: Direction a -> Direction a -> Bool
$cmax :: forall a. Ord a => Direction a -> Direction a -> Direction a
max :: Direction a -> Direction a -> Direction a
$cmin :: forall a. Ord a => Direction a -> Direction a -> Direction a
min :: Direction a -> Direction a -> Direction a
Ord, Int -> Direction a -> ShowS
[Direction a] -> ShowS
Direction a -> String
(Int -> Direction a -> ShowS)
-> (Direction a -> String)
-> ([Direction a] -> ShowS)
-> Show (Direction a)
forall a. Show a => Int -> Direction a -> ShowS
forall a. Show a => [Direction a] -> ShowS
forall a. Show a => Direction a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Direction a -> ShowS
showsPrec :: Int -> Direction a -> ShowS
$cshow :: forall a. Show a => Direction a -> String
show :: Direction a -> String
$cshowList :: forall a. Show a => [Direction a] -> ShowS
showList :: [Direction a] -> ShowS
Show, (forall a b. (a -> b) -> Direction a -> Direction b)
-> (forall a b. a -> Direction b -> Direction a)
-> Functor Direction
forall a b. a -> Direction b -> Direction a
forall a b. (a -> b) -> Direction a -> Direction b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Direction a -> Direction b
fmap :: forall a b. (a -> b) -> Direction a -> Direction b
$c<$ :: forall a b. a -> Direction b -> Direction a
<$ :: forall a b. a -> Direction b -> Direction a
Functor, (forall m. Monoid m => Direction m -> m)
-> (forall m a. Monoid m => (a -> m) -> Direction a -> m)
-> (forall m a. Monoid m => (a -> m) -> Direction a -> m)
-> (forall a b. (a -> b -> b) -> b -> Direction a -> b)
-> (forall a b. (a -> b -> b) -> b -> Direction a -> b)
-> (forall b a. (b -> a -> b) -> b -> Direction a -> b)
-> (forall b a. (b -> a -> b) -> b -> Direction a -> b)
-> (forall a. (a -> a -> a) -> Direction a -> a)
-> (forall a. (a -> a -> a) -> Direction a -> a)
-> (forall a. Direction a -> [a])
-> (forall a. Direction a -> Bool)
-> (forall a. Direction a -> Int)
-> (forall a. Eq a => a -> Direction a -> Bool)
-> (forall a. Ord a => Direction a -> a)
-> (forall a. Ord a => Direction a -> a)
-> (forall a. Num a => Direction a -> a)
-> (forall a. Num a => Direction a -> a)
-> Foldable Direction
forall a. Eq a => a -> Direction a -> Bool
forall a. Num a => Direction a -> a
forall a. Ord a => Direction a -> a
forall m. Monoid m => Direction m -> m
forall a. Direction a -> Bool
forall a. Direction a -> Int
forall a. Direction a -> [a]
forall a. (a -> a -> a) -> Direction a -> a
forall m a. Monoid m => (a -> m) -> Direction a -> m
forall b a. (b -> a -> b) -> b -> Direction a -> b
forall a b. (a -> b -> b) -> b -> Direction 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
$cfold :: forall m. Monoid m => Direction m -> m
fold :: forall m. Monoid m => Direction m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Direction a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Direction a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Direction a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Direction a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Direction a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Direction a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Direction a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Direction a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Direction a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Direction a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Direction a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Direction a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Direction a -> a
foldr1 :: forall a. (a -> a -> a) -> Direction a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Direction a -> a
foldl1 :: forall a. (a -> a -> a) -> Direction a -> a
$ctoList :: forall a. Direction a -> [a]
toList :: forall a. Direction a -> [a]
$cnull :: forall a. Direction a -> Bool
null :: forall a. Direction a -> Bool
$clength :: forall a. Direction a -> Int
length :: forall a. Direction a -> Int
$celem :: forall a. Eq a => a -> Direction a -> Bool
elem :: forall a. Eq a => a -> Direction a -> Bool
$cmaximum :: forall a. Ord a => Direction a -> a
maximum :: forall a. Ord a => Direction a -> a
$cminimum :: forall a. Ord a => Direction a -> a
minimum :: forall a. Ord a => Direction a -> a
$csum :: forall a. Num a => Direction a -> a
sum :: forall a. Num a => Direction a -> a
$cproduct :: forall a. Num a => Direction a -> a
product :: forall a. Num a => Direction a -> a
Foldable, Functor Direction
Foldable Direction
(Functor Direction, Foldable Direction) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Direction a -> f (Direction b))
-> (forall (f :: * -> *) a.
Applicative f =>
Direction (f a) -> f (Direction a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Direction a -> m (Direction b))
-> (forall (m :: * -> *) a.
Monad m =>
Direction (m a) -> m (Direction a))
-> Traversable Direction
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 =>
Direction (m a) -> m (Direction a)
forall (f :: * -> *) a.
Applicative f =>
Direction (f a) -> f (Direction a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Direction a -> m (Direction b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Direction a -> f (Direction b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Direction a -> f (Direction b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Direction a -> f (Direction b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Direction (f a) -> f (Direction a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Direction (f a) -> f (Direction a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Direction a -> m (Direction b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Direction a -> m (Direction b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Direction (m a) -> m (Direction a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Direction (m a) -> m (Direction a)
Traversable)
directed :: (Foldable f) => f (Cte v) -> Directed () (f (Cte v))
directed :: forall (f :: * -> *) v.
Foldable f =>
f (Cte v) -> Directed () (f (Cte v))
directed f (Cte v)
x = ((Cte v -> Direction ()) -> f (Cte v) -> Direction ()
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Cte v -> Direction ()
forall {v} {s}. CTE v s -> Direction ()
f f (Cte v)
x, f (Cte v)
x)
where
f :: CTE v s -> Direction ()
f (ST Direction Word16
d [v]
_ [Mem]
_ s
_) = () () -> Direction Word16 -> Direction ()
forall a b. a -> Direction b -> Direction a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Direction Word16
d
f CTE v s
_ = Direction ()
forall a. Direction a
Direct
instance (Semigroup a) => Semigroup (Direction a) where
Indirect a
l <> :: Direction a -> Direction a -> Direction a
<> Indirect a
r = a -> Direction a
forall a. a -> Direction a
Indirect (a -> Direction a) -> a -> Direction a
forall a b. (a -> b) -> a -> b
$ a
l a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
r
Direction a
Direct <> Direction a
r = Direction a
r
Direction a
l <> Direction a
Direct = Direction a
l
instance (Semigroup a) => Monoid (Direction a) where
mempty :: Direction a
mempty = Direction a
forall a. Direction a
Direct
type Directed a = (,) (Direction a)
type DNormal v = Directed () (ANormal v)
data SuperNormal v = Lambda {forall v. SuperNormal v -> [Mem]
conventions :: [Mem], forall v. SuperNormal v -> ANormal v
bound :: ANormal v}
deriving (Int -> SuperNormal v -> ShowS
[SuperNormal v] -> ShowS
SuperNormal v -> String
(Int -> SuperNormal v -> ShowS)
-> (SuperNormal v -> String)
-> ([SuperNormal v] -> ShowS)
-> Show (SuperNormal v)
forall v. Show v => Int -> SuperNormal v -> ShowS
forall v. Show v => [SuperNormal v] -> ShowS
forall v. Show v => SuperNormal v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> SuperNormal v -> ShowS
showsPrec :: Int -> SuperNormal v -> ShowS
$cshow :: forall v. Show v => SuperNormal v -> String
show :: SuperNormal v -> String
$cshowList :: forall v. Show v => [SuperNormal v] -> ShowS
showList :: [SuperNormal v] -> ShowS
Show, SuperNormal v -> SuperNormal v -> Bool
(SuperNormal v -> SuperNormal v -> Bool)
-> (SuperNormal v -> SuperNormal v -> Bool) -> Eq (SuperNormal v)
forall v. Var v => SuperNormal v -> SuperNormal v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Var v => SuperNormal v -> SuperNormal v -> Bool
== :: SuperNormal v -> SuperNormal v -> Bool
$c/= :: forall v. Var v => SuperNormal v -> SuperNormal v -> Bool
/= :: SuperNormal v -> SuperNormal v -> Bool
Eq)
data SuperGroup v = Rec
{ forall v. SuperGroup v -> [(v, SuperNormal v)]
group :: [(v, SuperNormal v)],
forall v. SuperGroup v -> SuperNormal v
entry :: SuperNormal v
}
deriving (Int -> SuperGroup v -> ShowS
[SuperGroup v] -> ShowS
SuperGroup v -> String
(Int -> SuperGroup v -> ShowS)
-> (SuperGroup v -> String)
-> ([SuperGroup v] -> ShowS)
-> Show (SuperGroup v)
forall v. Show v => Int -> SuperGroup v -> ShowS
forall v. Show v => [SuperGroup v] -> ShowS
forall v. Show v => SuperGroup v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> SuperGroup v -> ShowS
showsPrec :: Int -> SuperGroup v -> ShowS
$cshow :: forall v. Show v => SuperGroup v -> String
show :: SuperGroup v -> String
$cshowList :: forall v. Show v => [SuperGroup v] -> ShowS
showList :: [SuperGroup v] -> ShowS
Show)
instance (Var v) => Eq (SuperGroup v) where
SuperGroup v
g0 == :: SuperGroup v -> SuperGroup v -> Bool
== SuperGroup v
g1 | Left SGEqv v
_ <- SuperGroup v -> SuperGroup v -> Either (SGEqv v) ()
forall v.
Var v =>
SuperGroup v -> SuperGroup v -> Either (SGEqv v) ()
equivocate SuperGroup v
g0 SuperGroup v
g1 = Bool
False | Bool
otherwise = Bool
True
data SGEqv v
=
NumDefns (SuperGroup v) (SuperGroup v)
|
DefnConventions (SuperNormal v) (SuperNormal v)
|
Subterms (ANormal v) (ANormal v)
equivocate ::
(Var v) =>
SuperGroup v ->
SuperGroup v ->
Either (SGEqv v) ()
equivocate :: forall v.
Var v =>
SuperGroup v -> SuperGroup v -> Either (SGEqv v) ()
equivocate g0 :: SuperGroup v
g0@(Rec [(v, SuperNormal v)]
bs0 SuperNormal v
e0) g1 :: SuperGroup v
g1@(Rec [(v, SuperNormal v)]
bs1 SuperNormal v
e1)
| [(v, SuperNormal v)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(v, SuperNormal v)]
bs0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(v, SuperNormal v)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(v, SuperNormal v)]
bs1 =
((SuperNormal v, SuperNormal v) -> Either (SGEqv v) ())
-> [(SuperNormal v, SuperNormal v)] -> Either (SGEqv v) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (SuperNormal v, SuperNormal v) -> Either (SGEqv v) ()
eqvSN ([SuperNormal v]
-> [SuperNormal v] -> [(SuperNormal v, SuperNormal v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SuperNormal v]
ns0 [SuperNormal v]
ns1) Either (SGEqv v) () -> Either (SGEqv v) () -> Either (SGEqv v) ()
forall a b.
Either (SGEqv v) a -> Either (SGEqv v) b -> Either (SGEqv v) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SuperNormal v, SuperNormal v) -> Either (SGEqv v) ()
eqvSN (SuperNormal v
e0, SuperNormal v
e1)
| Bool
otherwise = SGEqv v -> Either (SGEqv v) ()
forall a b. a -> Either a b
Left (SGEqv v -> Either (SGEqv v) ()) -> SGEqv v -> Either (SGEqv v) ()
forall a b. (a -> b) -> a -> b
$ SuperGroup v -> SuperGroup v -> SGEqv v
forall v. SuperGroup v -> SuperGroup v -> SGEqv v
NumDefns SuperGroup v
g0 SuperGroup v
g1
where
([v]
vs0, [SuperNormal v]
ns0) = [(v, SuperNormal v)] -> ([v], [SuperNormal v])
forall a b. [(a, b)] -> ([a], [b])
unzip [(v, SuperNormal v)]
bs0
([v]
vs1, [SuperNormal v]
ns1) = [(v, SuperNormal v)] -> ([v], [SuperNormal v])
forall a b. [(a, b)] -> ([a], [b])
unzip [(v, SuperNormal v)]
bs1
vm :: Map v v
vm = [(v, v)] -> Map v v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([v] -> [v] -> [(v, v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
vs1 [v]
vs0)
promote :: Either (ANormal v, ANormal v) b -> Either (SGEqv v) b
promote (Left (ANormal v
l, ANormal v
r)) = SGEqv v -> Either (SGEqv v) b
forall a b. a -> Either a b
Left (SGEqv v -> Either (SGEqv v) b) -> SGEqv v -> Either (SGEqv v) b
forall a b. (a -> b) -> a -> b
$ ANormal v -> ANormal v -> SGEqv v
forall v. ANormal v -> ANormal v -> SGEqv v
Subterms ANormal v
l ANormal v
r
promote (Right b
v) = b -> Either (SGEqv v) b
forall a b. b -> Either a b
Right b
v
eqvSN :: (SuperNormal v, SuperNormal v) -> Either (SGEqv v) ()
eqvSN (Lambda [Mem]
ccs0 ANormal v
e0, Lambda [Mem]
ccs1 ANormal v
e1)
| [Mem]
ccs0 [Mem] -> [Mem] -> Bool
forall a. Eq a => a -> a -> Bool
== [Mem]
ccs1 = Either (ANormal v, ANormal v) () -> Either (SGEqv v) ()
forall {v} {b}.
Either (ANormal v, ANormal v) b -> Either (SGEqv v) b
promote (Either (ANormal v, ANormal v) () -> Either (SGEqv v) ())
-> Either (ANormal v, ANormal v) () -> Either (SGEqv v) ()
forall a b. (a -> b) -> a -> b
$ Map v v
-> ANormal v -> ANormal v -> Either (ANormal v, ANormal v) ()
forall (f :: * -> * -> *) v.
(Align f, Var v) =>
Map v v -> Term f v -> Term f v -> Either (Term f v, Term f v) ()
ABTN.alpha Map v v
vm ANormal v
e0 ANormal v
e1
eqvSN (SuperNormal v
n0, SuperNormal v
n1) = SGEqv v -> Either (SGEqv v) ()
forall a b. a -> Either a b
Left (SGEqv v -> Either (SGEqv v) ()) -> SGEqv v -> Either (SGEqv v) ()
forall a b. (a -> b) -> a -> b
$ SuperNormal v -> SuperNormal v -> SGEqv v
forall v. SuperNormal v -> SuperNormal v -> SGEqv v
DefnConventions SuperNormal v
n0 SuperNormal v
n1
type ANFM v =
ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
type ANFD v = Compose (ANFM v) (Directed ())
data GroupRef = GR Reference Word64
deriving (Int -> GroupRef -> ShowS
[GroupRef] -> ShowS
GroupRef -> String
(Int -> GroupRef -> ShowS)
-> (GroupRef -> String) -> ([GroupRef] -> ShowS) -> Show GroupRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GroupRef -> ShowS
showsPrec :: Int -> GroupRef -> ShowS
$cshow :: GroupRef -> String
show :: GroupRef -> String
$cshowList :: [GroupRef] -> ShowS
showList :: [GroupRef] -> ShowS
Show)
data Value
= Partial GroupRef [Word64] [Value]
| Data Reference Word64 [Word64] [Value]
| Cont [Word64] [Value] Cont
| BLit BLit
deriving (Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show)
data Cont
= KE
| Mark Word64 Word64 [Reference] (Map Reference Value) Cont
| Push Word64 Word64 Word64 Word64 GroupRef Cont
deriving (Int -> Cont -> ShowS
[Cont] -> ShowS
Cont -> String
(Int -> Cont -> ShowS)
-> (Cont -> String) -> ([Cont] -> ShowS) -> Show Cont
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cont -> ShowS
showsPrec :: Int -> Cont -> ShowS
$cshow :: Cont -> String
show :: Cont -> String
$cshowList :: [Cont] -> ShowS
showList :: [Cont] -> ShowS
Show)
data BLit
= Text Util.Text.Text
| List (Seq Value)
| TmLink Referent
| TyLink Reference
| Bytes Bytes
| Quote Value
| Code (SuperGroup Symbol)
| BArr PA.ByteArray
| Pos Word64
| Neg Word64
| Char Char
| Float Double
| Arr (PA.Array Value)
deriving (Int -> BLit -> ShowS
[BLit] -> ShowS
BLit -> String
(Int -> BLit -> ShowS)
-> (BLit -> String) -> ([BLit] -> ShowS) -> Show BLit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BLit -> ShowS
showsPrec :: Int -> BLit -> ShowS
$cshow :: BLit -> String
show :: BLit -> String
$cshowList :: [BLit] -> ShowS
showList :: [BLit] -> ShowS
Show)
groupVars :: ANFM v (Set v)
groupVars :: forall v. ANFM v (Set v)
groupVars = ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) (Set v)
forall r (m :: * -> *). MonadReader r m => m r
ask
bindLocal :: (Ord v) => [v] -> ANFM v r -> ANFM v r
bindLocal :: forall v r. Ord v => [v] -> ANFM v r -> ANFM v r
bindLocal [v]
vs = (Set v -> Set v)
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) r
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) r
forall a.
(Set v -> Set v)
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [v]
vs)
freshANF :: (Var v) => Word64 -> v
freshANF :: forall v. Var v => Word64 -> v
freshANF Word64
fr = Word64 -> v -> v
forall v. Var v => Word64 -> v -> v
Var.freshenId Word64
fr (v -> v) -> v -> v
forall a b. (a -> b) -> a -> b
$ Type -> v
forall v. Var v => Type -> v
typed Type
Var.ANFBlank
fresh :: (Var v) => ANFM v v
fresh :: forall v. Var v => ANFM v v
fresh = ((Word64, Word16, [(v, SuperNormal v)])
-> (v, (Word64, Word16, [(v, SuperNormal v)])))
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) v
forall a.
((Word64, Word16, [(v, SuperNormal v)])
-> (a, (Word64, Word16, [(v, SuperNormal v)])))
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (((Word64, Word16, [(v, SuperNormal v)])
-> (v, (Word64, Word16, [(v, SuperNormal v)])))
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) v)
-> ((Word64, Word16, [(v, SuperNormal v)])
-> (v, (Word64, Word16, [(v, SuperNormal v)])))
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) v
forall a b. (a -> b) -> a -> b
$ \(Word64
fr, Word16
bnd, [(v, SuperNormal v)]
cs) -> (Word64 -> v
forall v. Var v => Word64 -> v
freshANF Word64
fr, (Word64
fr Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1, Word16
bnd, [(v, SuperNormal v)]
cs))
contextualize :: (Var v) => DNormal v -> ANFM v (Ctx v, v)
contextualize :: forall v. Var v => DNormal v -> ANFM v (Ctx v, v)
contextualize (Direction ()
_, TVar v
cv) = do
Set v
gvs <- ANFM v (Set v)
forall v. ANFM v (Set v)
groupVars
if v
cv v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set v
gvs
then (Ctx v, v) -> ANFM v (Ctx v, v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [], v
cv)
else do
v
bv <- ANFM v v
forall v. Var v => ANFM v v
fresh
Direction Word16
d <- Word16 -> Direction Word16
forall a. a -> Direction a
Indirect (Word16 -> Direction Word16)
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) Word16
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Direction Word16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) Word16
forall v. ANFM v Word16
binder
pure ([Cte v] -> Ctx v
forall (f :: * -> *) v.
Foldable f =>
f (Cte v) -> Directed () (f (Cte v))
directed [Direction Word16 -> v -> Mem -> ANormal v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
d v
bv Mem
BX (ANormal v -> Cte v) -> ANormal v -> Cte v
forall a b. (a -> b) -> a -> b
$ v -> [v] -> ANormal v
forall v. Var v => v -> [v] -> Term ANormalF v
TApv v
cv []], v
bv)
contextualize (Direction ()
d0, ANormal v
tm) = do
v
fv <- ANFM v v
forall v. Var v => ANFM v v
fresh
Direction Word16
d <- Direction ()
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Direction Word16)
forall a v. Direction a -> ANFM v (Direction Word16)
bindDirection Direction ()
d0
pure ((Direction ()
d0, [Direction Word16 -> v -> Mem -> ANormal v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
d v
fv Mem
BX ANormal v
tm]), v
fv)
binder :: ANFM v Word16
binder :: forall v. ANFM v Word16
binder = ((Word64, Word16, [(v, SuperNormal v)])
-> (Word16, (Word64, Word16, [(v, SuperNormal v)])))
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) Word16
forall a.
((Word64, Word16, [(v, SuperNormal v)])
-> (a, (Word64, Word16, [(v, SuperNormal v)])))
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (((Word64, Word16, [(v, SuperNormal v)])
-> (Word16, (Word64, Word16, [(v, SuperNormal v)])))
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) Word16)
-> ((Word64, Word16, [(v, SuperNormal v)])
-> (Word16, (Word64, Word16, [(v, SuperNormal v)])))
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) Word16
forall a b. (a -> b) -> a -> b
$ \(Word64
fr, Word16
bnd, [(v, SuperNormal v)]
cs) -> (Word16
bnd, (Word64
fr, Word16
bnd Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1, [(v, SuperNormal v)]
cs))
bindDirection :: Direction a -> ANFM v (Direction Word16)
bindDirection :: forall a v. Direction a -> ANFM v (Direction Word16)
bindDirection = (a
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) Word16)
-> Direction a
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Direction Word16)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Direction a -> f (Direction b)
traverse (ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) Word16
-> a
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) Word16
forall a b. a -> b -> a
const ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) Word16
forall v. ANFM v Word16
binder)
record :: (Var v) => (v, SuperNormal v) -> ANFM v ()
record :: forall v. Var v => (v, SuperNormal v) -> ANFM v ()
record (v, SuperNormal v)
p = ((Word64, Word16, [(v, SuperNormal v)])
-> (Word64, Word16, [(v, SuperNormal v)]))
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((Word64, Word16, [(v, SuperNormal v)])
-> (Word64, Word16, [(v, SuperNormal v)]))
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) ())
-> ((Word64, Word16, [(v, SuperNormal v)])
-> (Word64, Word16, [(v, SuperNormal v)]))
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) ()
forall a b. (a -> b) -> a -> b
$ \(Word64
fr, Word16
bnd, [(v, SuperNormal v)]
to) -> (Word64
fr, Word16
bnd, (v, SuperNormal v)
p (v, SuperNormal v) -> [(v, SuperNormal v)] -> [(v, SuperNormal v)]
forall a. a -> [a] -> [a]
: [(v, SuperNormal v)]
to)
superNormalize :: (Var v) => Term v a -> SuperGroup v
superNormalize :: forall v a. Var v => Term v a -> SuperGroup v
superNormalize Term v a
tm = [(v, SuperNormal v)] -> SuperNormal v -> SuperGroup v
forall v. [(v, SuperNormal v)] -> SuperNormal v -> SuperGroup v
Rec [(v, SuperNormal v)]
l SuperNormal v
c
where
([(v, Term v a)]
bs, Term v a
e)
| LetRecNamed' [(v, Term v a)]
bs Term v a
e <- Term v a
tm = ([(v, Term v a)]
bs, Term v a
e)
| Bool
otherwise = ([], Term v a
tm)
grp :: Set v
grp = [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([v] -> Set v) -> [v] -> Set v
forall a b. (a -> b) -> a -> b
$ (v, Term v a) -> v
forall a b. (a, b) -> a
fst ((v, Term v a) -> v) -> [(v, Term v a)] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, Term v a)]
bs
comp :: ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(SuperNormal v)
comp = ((v, Term v a)
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) ())
-> [(v, Term v a)]
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (v, Term v a)
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) ()
forall v a. Var v => (v, Term v a) -> ANFM v ()
superBinding [(v, Term v a)]
bs ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) ()
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(SuperNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(SuperNormal v)
forall a b.
ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) b
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term v a
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(SuperNormal v)
forall v a. Var v => Term v a -> ANFM v (SuperNormal v)
toSuperNormal Term v a
e
subc :: State (Word64, Word16, [(v, SuperNormal v)]) (SuperNormal v)
subc = ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(SuperNormal v)
-> Set v
-> State (Word64, Word16, [(v, SuperNormal v)]) (SuperNormal v)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(SuperNormal v)
comp Set v
grp
(SuperNormal v
c, (Word64
_, Word16
_, [(v, SuperNormal v)]
l)) = State (Word64, Word16, [(v, SuperNormal v)]) (SuperNormal v)
-> (Word64, Word16, [(v, SuperNormal v)])
-> (SuperNormal v, (Word64, Word16, [(v, SuperNormal v)]))
forall s a. State s a -> s -> (a, s)
runState State (Word64, Word16, [(v, SuperNormal v)]) (SuperNormal v)
subc (Word64
0, Word16
1, [])
superBinding :: (Var v) => (v, Term v a) -> ANFM v ()
superBinding :: forall v a. Var v => (v, Term v a) -> ANFM v ()
superBinding (v
v, Term v a
tm) = do
SuperNormal v
nf <- Term v a -> ANFM v (SuperNormal v)
forall v a. Var v => Term v a -> ANFM v (SuperNormal v)
toSuperNormal Term v a
tm
((Word64, Word16, [(v, SuperNormal v)])
-> (Word64, Word16, [(v, SuperNormal v)]))
-> ANFM v ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((Word64, Word16, [(v, SuperNormal v)])
-> (Word64, Word16, [(v, SuperNormal v)]))
-> ANFM v ())
-> ((Word64, Word16, [(v, SuperNormal v)])
-> (Word64, Word16, [(v, SuperNormal v)]))
-> ANFM v ()
forall a b. (a -> b) -> a -> b
$ \(Word64
cvs, Word16
bnd, [(v, SuperNormal v)]
ctx) -> (Word64
cvs, Word16
bnd, (v
v, SuperNormal v
nf) (v, SuperNormal v) -> [(v, SuperNormal v)] -> [(v, SuperNormal v)]
forall a. a -> [a] -> [a]
: [(v, SuperNormal v)]
ctx)
toSuperNormal :: (Var v) => Term v a -> ANFM v (SuperNormal v)
toSuperNormal :: forall v a. Var v => Term v a -> ANFM v (SuperNormal v)
toSuperNormal Term v a
tm = do
Set v
grp <- ANFM v (Set v)
forall v. ANFM v (Set v)
groupVars
if Bool -> Bool
not (Bool -> Bool) -> (Set v -> Bool) -> Set v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set v -> Bool
forall a. Set a -> Bool
Set.null (Set v -> Bool) -> (Set v -> Set v) -> Set v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set v
grp) (Set v -> Bool) -> Set v -> Bool
forall a b. (a -> b) -> a -> b
$ Term v a -> Set v
forall vt v a. Term' vt v a -> Set v
freeVars Term v a
tm
then String -> ANFM v (SuperNormal v)
forall a. HasCallStack => String -> a
internalBug (String -> ANFM v (SuperNormal v))
-> String -> ANFM v (SuperNormal v)
forall a b. (a -> b) -> a -> b
$ String
"free variables in supercombinator: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Term v a -> String
forall a. Show a => a -> String
show Term v a
tm
else
[Mem] -> ANormal v -> SuperNormal v
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda (Mem
BX Mem -> [v] -> [Mem]
forall a b. a -> [b] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [v]
vs) (ANormal v -> SuperNormal v)
-> ((Direction (), ANormal v) -> ANormal v)
-> (Direction (), ANormal v)
-> SuperNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss [v]
vs (ANormal v -> ANormal v)
-> ((Direction (), ANormal v) -> ANormal v)
-> (Direction (), ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Direction (), ANormal v) -> ANormal v
forall a b. (a, b) -> b
snd
((Direction (), ANormal v) -> SuperNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Direction (), ANormal v)
-> ANFM v (SuperNormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Direction (), ANormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Direction (), ANormal v)
forall v r. Ord v => [v] -> ANFM v r -> ANFM v r
bindLocal [v]
vs (Term v a
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Direction (), ANormal v)
forall v a. Var v => Term v a -> ANFM v (DNormal v)
anfTerm Term v a
body)
where
([v]
vs, Term v a
body) = ([v], Term v a) -> Maybe ([v], Term v a) -> ([v], Term v a)
forall a. a -> Maybe a -> a
fromMaybe ([], Term v a
tm) (Maybe ([v], Term v a) -> ([v], Term v a))
-> Maybe ([v], Term v a) -> ([v], Term v a)
forall a b. (a -> b) -> a -> b
$ Term v a -> Maybe ([v], Term v a)
forall vt at ap v a.
Term2 vt at ap v a -> Maybe ([v], Term2 vt at ap v a)
unLams' Term v a
tm
anfTerm :: (Var v) => Term v a -> ANFM v (DNormal v)
anfTerm :: forall v a. Var v => Term v a -> ANFM v (DNormal v)
anfTerm Term v a
tm = ((Direction (), [Cte v]), (Direction (), ANormal v))
-> (Direction (), ANormal v)
forall {v} {a}.
Var v =>
((a, [Cte v]), (Direction (), ANormal v))
-> (Direction (), ANormal v)
f (((Direction (), [Cte v]), (Direction (), ANormal v))
-> (Direction (), ANormal v))
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
((Direction (), [Cte v]), (Direction (), ANormal v))
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Direction (), ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
((Direction (), [Cte v]), (Direction (), ANormal v))
forall v a. Var v => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
tm
where
f :: ((a, [Cte v]), (Direction (), ANormal v))
-> (Direction (), ANormal v)
f ((a
_, []), (Direction (), ANormal v)
dtm) = (Direction (), ANormal v)
dtm
f ((a
_, [Cte v]
cx), (Direction ()
_, ANormal v
tm)) = (() -> Direction ()
forall a. a -> Direction a
Indirect (), [Cte v] -> ANormal v -> ANormal v
forall v. Var v => [Cte v] -> ANormal v -> ANormal v
TBinds [Cte v]
cx ANormal v
tm)
floatableCtx :: (Var v) => Ctx v -> Bool
floatableCtx :: forall v. Var v => Ctx v -> Bool
floatableCtx = (CTE v (Term ANormalF v) -> Bool)
-> [CTE v (Term ANormalF v)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CTE v (Term ANormalF v) -> Bool
forall {v} {v}. Var v => CTE v (Term ANormalF v) -> Bool
p ([CTE v (Term ANormalF v)] -> Bool)
-> (Ctx v -> [CTE v (Term ANormalF v)]) -> Ctx v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v -> [CTE v (Term ANormalF v)]
forall a b. (a, b) -> b
snd
where
p :: CTE v (Term ANormalF v) -> Bool
p (LZ v
_ Either Reference v
_ [v]
_) = Bool
True
p (ST Direction Word16
_ [v]
_ [Mem]
_ Term ANormalF v
tm) = Term ANormalF v -> Bool
forall {v}. Var v => Term ANormalF v -> Bool
q Term ANormalF v
tm
q :: Term ANormalF v -> Bool
q (TLit Lit
_) = Bool
True
q (TVar v
_) = Bool
True
q (TCon Reference
_ CTag
_ [v]
_) = Bool
True
q Term ANormalF v
_ = Bool
False
anfHandled :: (Var v) => Term v a -> ANFM v (Ctx v, DNormal v)
anfHandled :: forall v a. Var v => Term v a -> ANFM v (Ctx v, DNormal v)
anfHandled Term v a
body =
Term v a -> ANFM v (Ctx v, DNormal v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
body ANFM v (Ctx v, DNormal v)
-> ((Ctx v, DNormal v) -> ANFM v (Ctx v, DNormal v))
-> ANFM v (Ctx v, DNormal v)
forall a b.
ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
-> (a
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) b)
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(Ctx v
ctx, (Direction ()
_, t :: ANormal v
t@TCon {})) ->
ANFM v v
forall v. Var v => ANFM v v
fresh ANFM v v -> (v -> (Ctx v, DNormal v)) -> ANFM v (Ctx v, DNormal v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v
v ->
(Ctx v
ctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Direction Word16 -> v -> Mem -> ANormal v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
forall a. Direction a
Direct v
v Mem
BX ANormal v
t], ANormal v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ANormal v -> DNormal v) -> ANormal v -> DNormal v
forall a b. (a -> b) -> a -> b
$ v -> ANormal v
forall v. Var v => v -> Term ANormalF v
TVar v
v)
(Ctx v
ctx, (Direction ()
_, t :: ANormal v
t@(TLit Lit
l))) ->
ANFM v v
forall v. Var v => ANFM v v
fresh ANFM v v -> (v -> (Ctx v, DNormal v)) -> ANFM v (Ctx v, DNormal v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v
v ->
(Ctx v
ctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Direction Word16 -> v -> Mem -> ANormal v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
forall a. Direction a
Direct v
v Mem
cc ANormal v
t], ANormal v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ANormal v -> DNormal v) -> ANormal v -> DNormal v
forall a b. (a -> b) -> a -> b
$ v -> ANormal v
forall v. Var v => v -> Term ANormalF v
TVar v
v)
where
cc :: Mem
cc = case Lit
l of T {} -> Mem
BX; LM {} -> Mem
BX; LY {} -> Mem
BX; Lit
_ -> Mem
UN
(Ctx v, DNormal v)
p -> (Ctx v, DNormal v) -> ANFM v (Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v, DNormal v)
p
fls, tru :: (Var v) => ANormal v
fls :: forall v. Var v => ANormal v
fls = Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.booleanRef CTag
0 []
tru :: forall v. Var v => ANormal v
tru = Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.booleanRef CTag
1 []
renameCtx :: (Var v) => v -> v -> Ctx v -> (Ctx v, Bool)
renameCtx :: forall v. Var v => v -> v -> Ctx v -> (Ctx v, Bool)
renameCtx v
v v
u (Direction ()
d, [Cte v]
ctx) | ([Cte v]
ctx, Bool
b) <- [Cte v] -> [Cte v] -> ([Cte v], Bool)
rn [] [Cte v]
ctx = ((Direction ()
d, [Cte v]
ctx), Bool
b)
where
swap :: v -> v
swap v
w
| v
w v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v = v
u
| Bool
otherwise = v
w
rn :: [Cte v] -> [Cte v] -> ([Cte v], Bool)
rn [Cte v]
acc [] = ([Cte v] -> [Cte v]
forall a. [a] -> [a]
reverse [Cte v]
acc, Bool
False)
rn [Cte v]
acc (ST Direction Word16
d [v]
vs [Mem]
ccs Term ANormalF v
b : [Cte v]
es)
| (v -> Bool) -> [v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v) [v]
vs = ([Cte v] -> [Cte v]
forall a. [a] -> [a]
reverse [Cte v]
acc [Cte v] -> [Cte v] -> [Cte v]
forall a. [a] -> [a] -> [a]
++ Cte v
e Cte v -> [Cte v] -> [Cte v]
forall a. a -> [a] -> [a]
: [Cte v]
es, Bool
True)
| Bool
otherwise = [Cte v] -> [Cte v] -> ([Cte v], Bool)
rn (Cte v
e Cte v -> [Cte v] -> [Cte v]
forall a. a -> [a] -> [a]
: [Cte v]
acc) [Cte v]
es
where
e :: Cte v
e = Direction Word16 -> [v] -> [Mem] -> Term ANormalF v -> Cte v
forall v s. Direction Word16 -> [v] -> [Mem] -> s -> CTE v s
ST Direction Word16
d [v]
vs [Mem]
ccs (Term ANormalF v -> Cte v) -> Term ANormalF v -> Cte v
forall a b. (a -> b) -> a -> b
$ v -> v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *).
(Var v, Ord v, Bifunctor f, Bifoldable f) =>
v -> v -> Term f v -> Term f v
ABTN.rename v
v v
u Term ANormalF v
b
rn [Cte v]
acc (LZ v
w Either Reference v
f [v]
as : [Cte v]
es)
| v
w v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v = ([Cte v] -> [Cte v]
forall a. [a] -> [a]
reverse [Cte v]
acc [Cte v] -> [Cte v] -> [Cte v]
forall a. [a] -> [a] -> [a]
++ Cte v
e Cte v -> [Cte v] -> [Cte v]
forall a. a -> [a] -> [a]
: [Cte v]
es, Bool
True)
| Bool
otherwise = [Cte v] -> [Cte v] -> ([Cte v], Bool)
rn (Cte v
e Cte v -> [Cte v] -> [Cte v]
forall a. a -> [a] -> [a]
: [Cte v]
acc) [Cte v]
es
where
e :: Cte v
e = v -> Either Reference v -> [v] -> Cte v
forall v s. v -> Either Reference v -> [v] -> CTE v s
LZ v
w (v -> v
swap (v -> v) -> Either Reference v -> Either Reference v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Reference v
f) (v -> v
swap (v -> v) -> [v] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
as)
anfBlock :: (Var v) => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock :: forall v a. Var v => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock (Var' v
v) = (Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v) -> Term ANormalF v -> DNormal v
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> Term ANormalF v
TVar v
v)
anfBlock (If' Term v a
c Term v a
t Term v a
f) = do
(Ctx v
cctx, DNormal v
cc) <- Term v a
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
c
(Direction ()
df, Term ANormalF v
cf) <- Term v a -> ANFM v (DNormal v)
forall v a. Var v => Term v a -> ANFM v (DNormal v)
anfTerm Term v a
f
(Direction ()
dt, Term ANormalF v
ct) <- Term v a -> ANFM v (DNormal v)
forall v a. Var v => Term v a -> ANFM v (DNormal v)
anfTerm Term v a
t
(Ctx v
cx, v
v) <- DNormal v -> ANFM v (Ctx v, v)
forall v. Var v => DNormal v -> ANFM v (Ctx v, v)
contextualize DNormal v
cc
let cases :: Branched (Term ANormalF v)
cases =
Reference
-> EnumMap CTag ([Mem], Term ANormalF v)
-> Maybe (Term ANormalF v)
-> Branched (Term ANormalF v)
forall e.
Reference -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched e
MatchData
(Text -> Reference
forall t h. t -> Reference' t h
Builtin (Text -> Reference) -> Text -> Reference
forall a b. (a -> b) -> a -> b
$ String -> Text
Data.Text.pack String
"Boolean")
(CTag
-> ([Mem], Term ANormalF v)
-> EnumMap CTag ([Mem], Term ANormalF v)
forall k a. EnumKey k => k -> a -> EnumMap k a
EC.mapSingleton CTag
0 ([], Term ANormalF v
cf))
(Term ANormalF v -> Maybe (Term ANormalF v)
forall a. a -> Maybe a
Just Term ANormalF v
ct)
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
cctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx, (() -> Direction ()
forall a. a -> Direction a
Indirect () Direction () -> Direction () -> Direction ()
forall a. Semigroup a => a -> a -> a
<> Direction ()
df Direction () -> Direction () -> Direction ()
forall a. Semigroup a => a -> a -> a
<> Direction ()
dt, v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
v Branched (Term ANormalF v)
cases))
anfBlock (And' Term v a
l Term v a
r) = do
(Ctx v
lctx, v
vl) <- Term v a -> ANFM v (Ctx v, v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, v)
anfArg Term v a
l
(Direction ()
d, Term ANormalF v
tmr) <- Term v a -> ANFM v (DNormal v)
forall v a. Var v => Term v a -> ANFM v (DNormal v)
anfTerm Term v a
r
let tree :: Term ANormalF v
tree =
v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
vl (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap CTag ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v))
-> EnumMap CTag ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference
-> EnumMap CTag ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. Reference -> EnumMap CTag ([Mem], e) -> Branched e
MatchDataCover Reference
Ty.booleanRef (EnumMap CTag ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap CTag ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
[(CTag, ([Mem], Term ANormalF v))]
-> EnumMap CTag ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
[ (CTag
0, ([], Term ANormalF v
forall v. Var v => ANormal v
fls)),
(CTag
1, ([], Term ANormalF v
tmr))
]
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
lctx, (() -> Direction ()
forall a. a -> Direction a
Indirect () Direction () -> Direction () -> Direction ()
forall a. Semigroup a => a -> a -> a
<> Direction ()
d, Term ANormalF v
tree))
anfBlock (Or' Term v a
l Term v a
r) = do
(Ctx v
lctx, v
vl) <- Term v a -> ANFM v (Ctx v, v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, v)
anfArg Term v a
l
(Direction ()
d, Term ANormalF v
tmr) <- Term v a -> ANFM v (DNormal v)
forall v a. Var v => Term v a -> ANFM v (DNormal v)
anfTerm Term v a
r
let tree :: Term ANormalF v
tree =
v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
vl (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap CTag ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v))
-> EnumMap CTag ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference
-> EnumMap CTag ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. Reference -> EnumMap CTag ([Mem], e) -> Branched e
MatchDataCover Reference
Ty.booleanRef (EnumMap CTag ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap CTag ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
[(CTag, ([Mem], Term ANormalF v))]
-> EnumMap CTag ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
[ (CTag
1, ([], Term ANormalF v
forall v. Var v => ANormal v
tru)),
(CTag
0, ([], Term ANormalF v
tmr))
]
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
lctx, (() -> Direction ()
forall a. a -> Direction a
Indirect () Direction () -> Direction () -> Direction ()
forall a. Semigroup a => a -> a -> a
<> Direction ()
d, Term ANormalF v
tree))
anfBlock (Handle' Term v a
h Term v a
body) =
Term v a -> ANFM v (Ctx v, v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, v)
anfArg Term v a
h ANFM v (Ctx v, v)
-> ((Ctx v, v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v))
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a b.
ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
-> (a
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) b)
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Ctx v
hctx, v
vh) ->
Term v a
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, DNormal v)
anfHandled Term v a
body ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
-> ((Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v))
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a b.
ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
-> (a
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) b)
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(Ctx v
ctx, (Direction ()
_, TCom Reference
f [v]
as)) | Ctx v -> Bool
forall v. Var v => Ctx v -> Bool
floatableCtx Ctx v
ctx -> do
v
v <- ANFM v v
forall v. Var v => ANFM v v
fresh
pure
( Ctx v
hctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
ctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [v -> Either Reference v -> [v] -> Cte v
forall v s. v -> Either Reference v -> [v] -> CTE v s
LZ v
v (Reference -> Either Reference v
forall a b. a -> Either a b
Left Reference
f) [v]
as],
(() -> Direction ()
forall a. a -> Direction a
Indirect (), Func v -> [v] -> Term ANormalF v
forall v. Var v => Func v -> [v] -> Term ANormalF v
TApp (v -> Func v
forall v. v -> Func v
FVar v
vh) [v
v])
)
(Ctx v
ctx, (Direction ()
_, TApv v
f [v]
as)) | Ctx v -> Bool
forall v. Var v => Ctx v -> Bool
floatableCtx Ctx v
ctx -> do
v
v <- ANFM v v
forall v. Var v => ANFM v v
fresh
pure
( Ctx v
hctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
ctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [v -> Either Reference v -> [v] -> Cte v
forall v s. v -> Either Reference v -> [v] -> CTE v s
LZ v
v (v -> Either Reference v
forall a b. b -> Either a b
Right v
f) [v]
as],
(() -> Direction ()
forall a. a -> Direction a
Indirect (), Func v -> [v] -> Term ANormalF v
forall v. Var v => Func v -> [v] -> Term ANormalF v
TApp (v -> Func v
forall v. v -> Func v
FVar v
vh) [v
v])
)
(Ctx v
ctx, (Direction ()
_, TVar v
v)) | Ctx v -> Bool
forall v. Var v => Ctx v -> Bool
floatableCtx Ctx v
ctx -> do
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
hctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
ctx, (() -> Direction ()
forall a. a -> Direction a
Indirect (), Func v -> [v] -> Term ANormalF v
forall v. Var v => Func v -> [v] -> Term ANormalF v
TApp (v -> Func v
forall v. v -> Func v
FVar v
vh) [v
v]))
p :: (Ctx v, DNormal v)
p@(Ctx v
_, DNormal v
_) ->
String
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a. HasCallStack => String -> a
internalBug (String
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v))
-> String
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a b. (a -> b) -> a -> b
$ String
"handle body should be a simple call: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Ctx v, DNormal v) -> String
forall a. Show a => a -> String
show (Ctx v, DNormal v)
p
anfBlock (Match' Term v a
scrut [MatchCase a (Term v a)]
cas) = do
(Ctx v
sctx, DNormal v
sc) <- Term v a
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
scrut
(Ctx v
cx, v
v) <- DNormal v -> ANFM v (Ctx v, v)
forall v. Var v => DNormal v -> ANFM v (Ctx v, v)
contextualize DNormal v
sc
(Direction ()
d, BranchAccum v
brn) <- v
-> [MatchCase a (Term v a)] -> ANFM v (Direction (), BranchAccum v)
forall v p a.
Var v =>
v
-> [MatchCase p (Term v a)] -> ANFM v (Directed () (BranchAccum v))
anfCases v
v [MatchCase a (Term v a)]
cas
(DNormal v -> DNormal v)
-> (Ctx v, DNormal v) -> (Ctx v, DNormal v)
forall a b. (a -> b) -> (Ctx v, a) -> (Ctx v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Direction () -> Direction ()) -> DNormal v -> DNormal v
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((() -> Direction ()
forall a. a -> Direction a
Indirect () Direction () -> Direction () -> Direction ()
forall a. Semigroup a => a -> a -> a
<> Direction ()
d) Direction () -> Direction () -> Direction ()
forall a. Semigroup a => a -> a -> a
<>)) ((Ctx v, DNormal v) -> (Ctx v, DNormal v))
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case BranchAccum v
brn of
AccumDefault (TBinds ([Cte v] -> Ctx v
forall (f :: * -> *) v.
Foldable f =>
f (Cte v) -> Directed () (f (Cte v))
directed -> Ctx v
dctx) Term ANormalF v
df) -> do
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
dctx, Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term ANormalF v
df)
AccumRequest Map Reference (EnumMap CTag ([Mem], Term ANormalF v))
_ Maybe (Term ANormalF v)
Nothing ->
String
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a. HasCallStack => String -> a
internalBug String
"anfBlock: AccumRequest without default"
AccumPure (ABTN.TAbss [v]
us Term ANormalF v
bd)
| [v
u] <- [v]
us,
TBinds ([Cte v] -> Ctx v
forall (f :: * -> *) v.
Foldable f =>
f (Cte v) -> Directed () (f (Cte v))
directed -> Ctx v
bx) Term ANormalF v
bd <- Term ANormalF v
bd ->
case Ctx v
cx of
(Direction ()
_, []) -> do
Direction Word16
d0 <- Word16 -> Direction Word16
forall a. a -> Direction a
Indirect (Word16 -> Direction Word16)
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) Word16
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Direction Word16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) Word16
forall v. ANFM v Word16
binder
pure (Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Direction Word16 -> v -> Mem -> Term ANormalF v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
d0 v
u Mem
BX (v -> Term ANormalF v
forall v. Var v => v -> Term ANormalF v
TFrc v
v)] Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
bx, Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term ANormalF v
bd)
(Direction ()
d0, [ST1 Direction Word16
d1 v
_ Mem
BX Term ANormalF v
tm]) ->
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> (Direction ()
d0, [Direction Word16 -> v -> Mem -> Term ANormalF v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
d1 v
u Mem
BX Term ANormalF v
tm]) Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
bx, Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term ANormalF v
bd)
Ctx v
_ -> String
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a. HasCallStack => String -> a
internalBug String
"anfBlock|AccumPure: impossible"
| Bool
otherwise -> String
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a. HasCallStack => String -> a
internalBug String
"pure handler with too many variables"
AccumRequest Map Reference (EnumMap CTag ([Mem], Term ANormalF v))
abr (Just Term ANormalF v
df) -> do
(v
r, [v]
vs) <- do
v
r <- ANFM v v
forall v. Var v => ANFM v v
fresh
v
v <- ANFM v v
forall v. Var v => ANFM v v
fresh
Set v
gvs <- ANFM v (Set v)
forall v. ANFM v (Set v)
groupVars
let hfb :: Term ANormalF v
hfb = v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
ABTN.TAbs v
v (Term ANormalF v -> Term ANormalF v)
-> (Branched (Term ANormalF v) -> Term ANormalF v)
-> Branched (Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
v (Branched (Term ANormalF v) -> Term ANormalF v)
-> Branched (Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ Map Reference (EnumMap CTag ([Mem], Term ANormalF v))
-> Term ANormalF v -> Branched (Term ANormalF v)
forall e.
Map Reference (EnumMap CTag ([Mem], e)) -> e -> Branched e
MatchRequest Map Reference (EnumMap CTag ([Mem], Term ANormalF v))
abr Term ANormalF v
df
hfvs :: [v]
hfvs = Set v -> [v]
forall a. Set a -> [a]
Set.toList (Set v -> [v]) -> Set v -> [v]
forall a b. (a -> b) -> a -> b
$ Term ANormalF v -> Set v
forall (f :: * -> * -> *) v. Term f v -> Set v
ABTN.freeVars Term ANormalF v
hfb Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set v
gvs
(v, SuperNormal v) -> ANFM v ()
forall v. Var v => (v, SuperNormal v) -> ANFM v ()
record (v
r, [Mem] -> Term ANormalF v -> SuperNormal v
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda (Mem
BX Mem -> [v] -> [Mem]
forall a b. a -> [b] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [v]
hfvs [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
++ [v
v]) (Term ANormalF v -> SuperNormal v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> SuperNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss [v]
hfvs (Term ANormalF v -> SuperNormal v)
-> Term ANormalF v -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ Term ANormalF v
hfb)
pure (v
r, [v]
hfvs)
v
hv <- ANFM v v
forall v. Var v => ANFM v v
fresh
let (Direction ()
d, Term ANormalF v
msc)
| (Direction ()
d, [ST1 Direction Word16
_ v
_ Mem
BX Term ANormalF v
tm]) <- Ctx v
cx = (Direction ()
d, Term ANormalF v
tm)
| (Direction ()
_, [ST Direction Word16
_ [v]
_ [Mem]
_ Term ANormalF v
_]) <- Ctx v
cx =
String -> DNormal v
forall a. HasCallStack => String -> a
internalBug String
"anfBlock: impossible"
| Bool
otherwise = (() -> Direction ()
forall a. a -> Direction a
Indirect (), v -> Term ANormalF v
forall v. Var v => v -> Term ANormalF v
TFrc v
v)
pure
( Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [v -> Either Reference v -> [v] -> Cte v
forall v s. v -> Either Reference v -> [v] -> CTE v s
LZ v
hv (v -> Either Reference v
forall a b. b -> Either a b
Right v
r) [v]
vs],
(Direction ()
d, [Reference] -> v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
[Reference] -> v -> Term ANormalF v -> Term ANormalF v
THnd (Map Reference (EnumMap CTag ([Mem], Term ANormalF v))
-> [Reference]
forall k a. Map k a -> [k]
Map.keys Map Reference (EnumMap CTag ([Mem], Term ANormalF v))
abr) v
hv Term ANormalF v
msc)
)
AccumText Maybe (Term ANormalF v)
df Map Text (Term ANormalF v)
cs ->
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx, Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v)
-> (Branched (Term ANormalF v) -> Term ANormalF v)
-> Branched (Term ANormalF v)
-> DNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
v (Branched (Term ANormalF v) -> DNormal v)
-> Branched (Term ANormalF v) -> DNormal v
forall a b. (a -> b) -> a -> b
$ Map Text (Term ANormalF v)
-> Maybe (Term ANormalF v) -> Branched (Term ANormalF v)
forall e. Map Text e -> Maybe e -> Branched e
MatchText Map Text (Term ANormalF v)
cs Maybe (Term ANormalF v)
df)
AccumIntegral Reference
r Maybe (Term ANormalF v)
df EnumMap Word64 (Term ANormalF v)
cs ->
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx, Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v) -> Term ANormalF v -> DNormal v
forall a b. (a -> b) -> a -> b
$ v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
v (Branched (Term ANormalF v) -> Term ANormalF v)
-> Branched (Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ Reference
-> EnumMap Word64 (Term ANormalF v)
-> Maybe (Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. Reference -> EnumMap Word64 e -> Maybe e -> Branched e
MatchNumeric Reference
r EnumMap Word64 (Term ANormalF v)
cs Maybe (Term ANormalF v)
df)
AccumData Reference
r Maybe (Term ANormalF v)
df EnumMap CTag ([Mem], Term ANormalF v)
cs ->
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx, Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v)
-> (Branched (Term ANormalF v) -> Term ANormalF v)
-> Branched (Term ANormalF v)
-> DNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
v (Branched (Term ANormalF v) -> DNormal v)
-> Branched (Term ANormalF v) -> DNormal v
forall a b. (a -> b) -> a -> b
$ Reference
-> EnumMap CTag ([Mem], Term ANormalF v)
-> Maybe (Term ANormalF v)
-> Branched (Term ANormalF v)
forall e.
Reference -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched e
MatchData Reference
r EnumMap CTag ([Mem], Term ANormalF v)
cs Maybe (Term ANormalF v)
df)
AccumSeqEmpty Term ANormalF v
_ ->
String
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a. HasCallStack => String -> a
internalBug String
"anfBlock: non-exhaustive AccumSeqEmpty"
AccumSeqView SeqEnd
en (Just Term ANormalF v
em) Term ANormalF v
bd -> do
v
r <- ANFM v v
forall v. Var v => ANFM v v
fresh
let op :: Reference
op
| SeqEnd
SLeft <- SeqEnd
en = Text -> Reference
forall t h. t -> Reference' t h
Builtin Text
"List.viewl"
| Bool
otherwise = Text -> Reference
forall t h. t -> Reference' t h
Builtin Text
"List.viewr"
Word16
b <- ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) Word16
forall v. ANFM v Word16
binder
pure
( Ctx v
sctx
Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx
Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> (() -> Direction ()
forall a. a -> Direction a
Indirect (), [Direction Word16 -> v -> Mem -> Term ANormalF v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 (Word16 -> Direction Word16
forall a. a -> Direction a
Indirect Word16
b) v
r Mem
BX (Reference -> [v] -> Term ANormalF v
forall v. Var v => Reference -> [v] -> Term ANormalF v
TCom Reference
op [v
v])]),
Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v)
-> (Branched (Term ANormalF v) -> Term ANormalF v)
-> Branched (Term ANormalF v)
-> DNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
r (Branched (Term ANormalF v) -> DNormal v)
-> Branched (Term ANormalF v) -> DNormal v
forall a b. (a -> b) -> a -> b
$
Reference
-> EnumMap CTag ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. Reference -> EnumMap CTag ([Mem], e) -> Branched e
MatchDataCover
Reference
Ty.seqViewRef
( [(CTag, ([Mem], Term ANormalF v))]
-> EnumMap CTag ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
EC.mapFromList
[ (Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.seqViewEmpty, ([], Term ANormalF v
em)),
(Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.seqViewElem, ([Mem
BX, Mem
BX], Term ANormalF v
bd))
]
)
)
AccumSeqView {} ->
String
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a. HasCallStack => String -> a
internalBug String
"anfBlock: non-exhaustive AccumSeqView"
AccumSeqSplit SeqEnd
en Int
n Maybe (Term ANormalF v)
mdf Term ANormalF v
bd -> do
v
i <- ANFM v v
forall v. Var v => ANFM v v
fresh
v
r <- ANFM v v
forall v. Var v => ANFM v v
fresh
v
s <- ANFM v v
forall v. Var v => ANFM v v
fresh
Word16
b <- ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) Word16
forall v. ANFM v Word16
binder
let split :: Cte v
split = Direction Word16 -> v -> Mem -> Term ANormalF v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 (Word16 -> Direction Word16
forall a. a -> Direction a
Indirect Word16
b) v
r Mem
BX (Reference -> [v] -> Term ANormalF v
forall v. Var v => Reference -> [v] -> Term ANormalF v
TCom Reference
op [v
i, v
v])
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall (f :: * -> *) v.
Foldable f =>
f (Cte v) -> Directed () (f (Cte v))
directed [v -> Cte v
lit v
i, Cte v
split],
Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v)
-> (EnumMap CTag ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap CTag ([Mem], Term ANormalF v)
-> DNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
r (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap CTag ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v))
-> EnumMap CTag ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference
-> EnumMap CTag ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. Reference -> EnumMap CTag ([Mem], e) -> Branched e
MatchDataCover Reference
Ty.seqViewRef (EnumMap CTag ([Mem], Term ANormalF v) -> DNormal v)
-> EnumMap CTag ([Mem], Term ANormalF v) -> DNormal v
forall a b. (a -> b) -> a -> b
$
[(CTag, ([Mem], Term ANormalF v))]
-> EnumMap CTag ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
[ (Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.seqViewEmpty, ([], v -> Term ANormalF v
df v
s)),
(Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.seqViewElem, ([Mem
BX, Mem
BX], Term ANormalF v
bd))
]
)
where
op :: Reference
op
| SeqEnd
SLeft <- SeqEnd
en = Text -> Reference
forall t h. t -> Reference' t h
Builtin Text
"List.splitLeft"
| Bool
otherwise = Text -> Reference
forall t h. t -> Reference' t h
Builtin Text
"List.splitRight"
lit :: v -> Cte v
lit v
i = Direction Word16 -> v -> Mem -> Term ANormalF v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
forall a. Direction a
Direct v
i Mem
BX (Lit -> Term ANormalF v
forall v. Var v => Lit -> Term ANormalF v
TBLit (Lit -> Term ANormalF v)
-> (Word64 -> Lit) -> Word64 -> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Lit
N (Word64 -> Term ANormalF v) -> Word64 -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
df :: v -> Term ANormalF v
df v
n =
Term ANormalF v -> Maybe (Term ANormalF v) -> Term ANormalF v
forall a. a -> Maybe a -> a
fromMaybe
( Direction Word16
-> v
-> Mem
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
forall v.
Var v =>
Direction Word16
-> v
-> Mem
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
TLet Direction Word16
forall a. Direction a
Direct v
n Mem
BX (Lit -> Term ANormalF v
forall v. Var v => Lit -> Term ANormalF v
TLit (Text -> Lit
T Text
"pattern match failure")) (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
POp -> [v] -> Term ANormalF v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
EROR [v
n, v
v]
)
Maybe (Term ANormalF v)
mdf
BranchAccum v
AccumEmpty -> (Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx, Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v) -> Term ANormalF v -> DNormal v
forall a b. (a -> b) -> a -> b
$ v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
v Branched (Term ANormalF v)
forall e. Branched e
MatchEmpty)
anfBlock (Let1Named' v
v Term v a
b Term v a
e) =
Term v a
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
b ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
-> ((Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v))
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a b.
ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
-> (a
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) b)
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(Ctx v
bctx, (Direction ()
Direct, TVar v
u)) -> do
(Ctx v
ectx, DNormal v
ce) <- Term v a
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
e
(Ctx v
ectx, Bool
shaded) <- (Ctx v, Bool)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, Bool)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Ctx v, Bool)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, Bool))
-> (Ctx v, Bool)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, Bool)
forall a b. (a -> b) -> a -> b
$ v -> v -> Ctx v -> (Ctx v, Bool)
forall v. Var v => v -> v -> Ctx v -> (Ctx v, Bool)
renameCtx v
v v
u Ctx v
ectx
DNormal v
ce <- DNormal v -> ANFM v (DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DNormal v -> ANFM v (DNormal v))
-> DNormal v -> ANFM v (DNormal v)
forall a b. (a -> b) -> a -> b
$ if Bool
shaded then DNormal v
ce else v -> v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *).
(Var v, Ord v, Bifunctor f, Bifoldable f) =>
v -> v -> Term f v -> Term f v
ABTN.rename v
v v
u (Term ANormalF v -> Term ANormalF v) -> DNormal v -> DNormal v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DNormal v
ce
pure (Ctx v
bctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
ectx, DNormal v
ce)
(Ctx v
bctx, (Direction ()
d0, Term ANormalF v
cb)) -> [v]
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall v r. Ord v => [v] -> ANFM v r -> ANFM v r
bindLocal [v
v] (ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v))
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a b. (a -> b) -> a -> b
$ do
(Ctx v
ectx, DNormal v
ce) <- Term v a
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
e
Direction Word16
d <- Direction ()
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Direction Word16)
forall a v. Direction a -> ANFM v (Direction Word16)
bindDirection Direction ()
d0
let octx :: Ctx v
octx = Ctx v
bctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall (f :: * -> *) v.
Foldable f =>
f (Cte v) -> Directed () (f (Cte v))
directed [Direction Word16 -> v -> Mem -> Term ANormalF v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
d v
v Mem
BX Term ANormalF v
cb] Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
ectx
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
octx, DNormal v
ce)
anfBlock (Apps' (Blank' Blank a
b) [Term v a]
args) = do
v
nm <- ANFM v v
forall v. Var v => ANFM v v
fresh
(Ctx v
actx, [v]
cas) <- [Term v a] -> ANFM v (Ctx v, [v])
forall v a. Var v => [Term v a] -> ANFM v (Ctx v, [v])
anfArgs [Term v a]
args
pure
( Ctx v
actx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Direction Word16 -> v -> Mem -> Term ANormalF v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
forall a. Direction a
Direct v
nm Mem
BX (Lit -> Term ANormalF v
forall v. Var v => Lit -> Term ANormalF v
TLit (Text -> Lit
T Text
msg))],
Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v) -> Term ANormalF v -> DNormal v
forall a b. (a -> b) -> a -> b
$ POp -> [v] -> Term ANormalF v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
EROR (v
nm v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
cas)
)
where
msg :: Text
msg = String -> Text
Util.Text.pack (String -> Text)
-> (Maybe String -> String) -> Maybe String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"blank expression" (Maybe String -> Text) -> Maybe String -> Text
forall a b. (a -> b) -> a -> b
$ Blank a -> Maybe String
forall loc. Blank loc -> Maybe String
nameb Blank a
b
anfBlock (Apps' Term v a
f [Term v a]
args) = do
(Ctx v
fctx, (Direction ()
d, Func v
cf)) <- Term v a -> ANFM v (Ctx v, Directed () (Func v))
forall v a.
Var v =>
Term v a -> ANFM v (Ctx v, Directed () (Func v))
anfFunc Term v a
f
(Ctx v
actx, [v]
cas) <- [Term v a] -> ANFM v (Ctx v, [v])
forall v a. Var v => [Term v a] -> ANFM v (Ctx v, [v])
anfArgs [Term v a]
args
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
fctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
actx, (Direction ()
d, Func v -> [v] -> Term ANormalF v
forall v. Var v => Func v -> [v] -> Term ANormalF v
TApp Func v
cf [v]
cas))
anfBlock (Constructor' (ConstructorReference Reference
r Word64
t)) =
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v) -> Term ANormalF v -> DNormal v
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
r (Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
t) [])
anfBlock (Request' (ConstructorReference Reference
r Word64
t)) =
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, (() -> Direction ()
forall a. a -> Direction a
Indirect (), Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TReq Reference
r (Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
t) []))
anfBlock (Boolean' Bool
b) =
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v) -> Term ANormalF v -> DNormal v
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.booleanRef (if Bool
b then CTag
1 else CTag
0) [])
anfBlock (Lit' l :: Lit
l@(T Text
_)) =
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v) -> Term ANormalF v -> DNormal v
forall a b. (a -> b) -> a -> b
$ Lit -> Term ANormalF v
forall v. Var v => Lit -> Term ANormalF v
TLit Lit
l)
anfBlock (Lit' Lit
l) =
(Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v) -> Term ANormalF v -> DNormal v
forall a b. (a -> b) -> a -> b
$ Lit -> Term ANormalF v
forall v. Var v => Lit -> Term ANormalF v
TBLit Lit
l)
anfBlock (Ref' Reference
r) = (Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, (() -> Direction ()
forall a. a -> Direction a
Indirect (), Reference -> [v] -> Term ANormalF v
forall v. Var v => Reference -> [v] -> Term ANormalF v
TCom Reference
r []))
anfBlock (Blank' Blank a
b) = do
v
nm <- ANFM v v
forall v. Var v => ANFM v v
fresh
v
ev <- ANFM v v
forall v. Var v => ANFM v v
fresh
pure
( [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
[ Direction Word16 -> v -> Mem -> Term ANormalF v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
forall a. Direction a
Direct v
nm Mem
BX (Lit -> Term ANormalF v
forall v. Var v => Lit -> Term ANormalF v
TLit (Text -> Lit
T Text
name)),
Direction Word16 -> v -> Mem -> Term ANormalF v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
forall a. Direction a
Direct v
ev Mem
BX (Lit -> Term ANormalF v
forall v. Var v => Lit -> Term ANormalF v
TLit (Text -> Lit
T (Text -> Lit) -> Text -> Lit
forall a b. (a -> b) -> a -> b
$ String -> Text
Util.Text.pack String
msg))
],
Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v) -> Term ANormalF v -> DNormal v
forall a b. (a -> b) -> a -> b
$ POp -> [v] -> Term ANormalF v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
EROR [v
nm, v
ev]
)
where
name :: Text
name = Text
"blank expression"
msg :: String
msg = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"blank expression" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Blank a -> Maybe String
forall loc. Blank loc -> Maybe String
nameb Blank a
b
anfBlock (TermLink' Referent
r) = (Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v)
-> (Lit -> Term ANormalF v) -> Lit -> DNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> Term ANormalF v
forall v. Var v => Lit -> Term ANormalF v
TLit (Lit -> DNormal v) -> Lit -> DNormal v
forall a b. (a -> b) -> a -> b
$ Referent -> Lit
LM Referent
r)
anfBlock (TypeLink' Reference
r) = (Ctx v, DNormal v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v)
-> (Lit -> Term ANormalF v) -> Lit -> DNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> Term ANormalF v
forall v. Var v => Lit -> Term ANormalF v
TLit (Lit -> DNormal v) -> Lit -> DNormal v
forall a b. (a -> b) -> a -> b
$ Reference -> Lit
LY Reference
r)
anfBlock (List' Seq (Term v a)
as) = ([v] -> DNormal v) -> (Ctx v, [v]) -> (Ctx v, DNormal v)
forall a b. (a -> b) -> (Ctx v, a) -> (Ctx v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Term ANormalF v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term ANormalF v -> DNormal v)
-> ([v] -> Term ANormalF v) -> [v] -> DNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POp -> [v] -> Term ANormalF v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
BLDS) ((Ctx v, [v]) -> (Ctx v, DNormal v))
-> ANFM v (Ctx v, [v])
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Term v a] -> ANFM v (Ctx v, [v])
forall v a. Var v => [Term v a] -> ANFM v (Ctx v, [v])
anfArgs [Term v a]
tms
where
tms :: [Term v a]
tms = Seq (Term v a) -> [Term v a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Term v a)
as
anfBlock Term v a
t = String
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a. HasCallStack => String -> a
internalBug (String
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v))
-> String
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, DNormal v)
forall a b. (a -> b) -> a -> b
$ String
"anf: unhandled term: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Term v a -> String
forall a. Show a => a -> String
show Term v a
t
anfInitCase ::
(Var v) =>
v ->
MatchCase p (Term v a) ->
ANFD v (BranchAccum v)
anfInitCase :: forall v p a.
Var v =>
v -> MatchCase p (Term v a) -> ANFD v (BranchAccum v)
anfInitCase v
u (MatchCase Pattern p
p Maybe (Term v a)
guard (ABT.AbsN' [v]
vs Term v a
bd))
| Just Term v a
_ <- Maybe (Term v a)
guard = String -> ANFD v (BranchAccum v)
forall a. HasCallStack => String -> a
internalBug String
"anfInitCase: unexpected guard"
| P.Unbound p
_ <- Pattern p
p,
[] <- [v]
vs =
ANormal v -> BranchAccum v
forall v. ANormal v -> BranchAccum v
AccumDefault (ANormal v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a -> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
anfBody Term v a
bd
| P.Var p
_ <- Pattern p
p,
[v
v] <- [v]
vs =
ANormal v -> BranchAccum v
forall v. ANormal v -> BranchAccum v
AccumDefault (ANormal v -> BranchAccum v)
-> (ANormal v -> ANormal v) -> ANormal v -> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> v -> ANormal v -> ANormal v
forall v (f :: * -> * -> *).
(Var v, Ord v, Bifunctor f, Bifoldable f) =>
v -> v -> Term f v -> Term f v
ABTN.rename v
v v
u (ANormal v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a -> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
anfBody Term v a
bd
| P.Var p
_ <- Pattern p
p =
String -> ANFD v (BranchAccum v)
forall a. HasCallStack => String -> a
internalBug (String -> ANFD v (BranchAccum v))
-> String -> ANFD v (BranchAccum v)
forall a b. (a -> b) -> a -> b
$ String
"vars: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
vs)
| P.Int p
_ (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word64
i) <- Pattern p
p =
Reference
-> Maybe (ANormal v) -> EnumMap Word64 (ANormal v) -> BranchAccum v
forall v.
Reference
-> Maybe (ANormal v) -> EnumMap Word64 (ANormal v) -> BranchAccum v
AccumIntegral Reference
Ty.intRef Maybe (ANormal v)
forall a. Maybe a
Nothing (EnumMap Word64 (ANormal v) -> BranchAccum v)
-> (ANormal v -> EnumMap Word64 (ANormal v))
-> ANormal v
-> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ANormal v -> EnumMap Word64 (ANormal v)
forall k a. EnumKey k => k -> a -> EnumMap k a
EC.mapSingleton Word64
i (ANormal v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a -> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
anfBody Term v a
bd
| P.Nat p
_ Word64
i <- Pattern p
p =
Reference
-> Maybe (ANormal v) -> EnumMap Word64 (ANormal v) -> BranchAccum v
forall v.
Reference
-> Maybe (ANormal v) -> EnumMap Word64 (ANormal v) -> BranchAccum v
AccumIntegral Reference
Ty.natRef Maybe (ANormal v)
forall a. Maybe a
Nothing (EnumMap Word64 (ANormal v) -> BranchAccum v)
-> (ANormal v -> EnumMap Word64 (ANormal v))
-> ANormal v
-> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ANormal v -> EnumMap Word64 (ANormal v)
forall k a. EnumKey k => k -> a -> EnumMap k a
EC.mapSingleton Word64
i (ANormal v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a -> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
anfBody Term v a
bd
| P.Char p
_ Char
c <- Pattern p
p,
Word64
w <- Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c =
Reference
-> Maybe (ANormal v) -> EnumMap Word64 (ANormal v) -> BranchAccum v
forall v.
Reference
-> Maybe (ANormal v) -> EnumMap Word64 (ANormal v) -> BranchAccum v
AccumIntegral Reference
Ty.charRef Maybe (ANormal v)
forall a. Maybe a
Nothing (EnumMap Word64 (ANormal v) -> BranchAccum v)
-> (ANormal v -> EnumMap Word64 (ANormal v))
-> ANormal v
-> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ANormal v -> EnumMap Word64 (ANormal v)
forall k a. EnumKey k => k -> a -> EnumMap k a
EC.mapSingleton Word64
w (ANormal v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a -> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
anfBody Term v a
bd
| P.Boolean p
_ Bool
b <- Pattern p
p,
CTag
t <- if Bool
b then CTag
1 else CTag
0 =
Reference
-> Maybe (ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> BranchAccum v
forall v.
Reference
-> Maybe (ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> BranchAccum v
AccumData Reference
Ty.booleanRef Maybe (ANormal v)
forall a. Maybe a
Nothing
(EnumMap CTag ([Mem], ANormal v) -> BranchAccum v)
-> (ANormal v -> EnumMap CTag ([Mem], ANormal v))
-> ANormal v
-> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTag -> ([Mem], ANormal v) -> EnumMap CTag ([Mem], ANormal v)
forall k a. EnumKey k => k -> a -> EnumMap k a
EC.mapSingleton CTag
t
(([Mem], ANormal v) -> EnumMap CTag ([Mem], ANormal v))
-> (ANormal v -> ([Mem], ANormal v))
-> ANormal v
-> EnumMap CTag ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],)
(ANormal v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a -> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
anfBody Term v a
bd
| P.Text p
_ Text
t <- Pattern p
p,
[] <- [v]
vs =
Maybe (ANormal v) -> Map Text (ANormal v) -> BranchAccum v
forall v.
Maybe (ANormal v) -> Map Text (ANormal v) -> BranchAccum v
AccumText Maybe (ANormal v)
forall a. Maybe a
Nothing (Map Text (ANormal v) -> BranchAccum v)
-> (ANormal v -> Map Text (ANormal v))
-> ANormal v
-> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ANormal v -> Map Text (ANormal v)
forall k a. k -> a -> Map k a
Map.singleton (Text -> Text
Util.Text.fromText Text
t) (ANormal v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a -> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
anfBody Term v a
bd
| P.Constructor p
_ (ConstructorReference Reference
r Word64
t) [Pattern p]
ps <- Pattern p
p = do
(,)
([v] -> ANormal v -> ([v], ANormal v))
-> Compose (ANFM v) ((,) (Direction ())) [v]
-> Compose
(ANFM v) ((,) (Direction ())) (ANormal v -> ([v], ANormal v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern p] -> [v] -> Compose (ANFM v) ((,) (Direction ())) [v]
forall v p. Var v => [Pattern p] -> [v] -> ANFD v [v]
expandBindings [Pattern p]
ps [v]
vs
Compose
(ANFM v) ((,) (Direction ())) (ANormal v -> ([v], ANormal v))
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) ([v], ANormal v)
forall a b.
Compose (ANFM v) ((,) (Direction ())) (a -> b)
-> Compose (ANFM v) ((,) (Direction ())) a
-> Compose (ANFM v) ((,) (Direction ())) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term v a -> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
anfBody Term v a
bd
Compose (ANFM v) ((,) (Direction ())) ([v], ANormal v)
-> (([v], ANormal v) -> BranchAccum v) -> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \([v]
us, ANormal v
bd) ->
Reference
-> Maybe (ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> BranchAccum v
forall v.
Reference
-> Maybe (ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> BranchAccum v
AccumData Reference
r Maybe (ANormal v)
forall a. Maybe a
Nothing (EnumMap CTag ([Mem], ANormal v) -> BranchAccum v)
-> (ANormal v -> EnumMap CTag ([Mem], ANormal v))
-> ANormal v
-> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTag -> ([Mem], ANormal v) -> EnumMap CTag ([Mem], ANormal v)
forall k a. EnumKey k => k -> a -> EnumMap k a
EC.mapSingleton (Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
t) (([Mem], ANormal v) -> EnumMap CTag ([Mem], ANormal v))
-> (ANormal v -> ([Mem], ANormal v))
-> ANormal v
-> EnumMap CTag ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mem
BX Mem -> [v] -> [Mem]
forall a b. a -> [b] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [v]
us,) (ANormal v -> BranchAccum v) -> ANormal v -> BranchAccum v
forall a b. (a -> b) -> a -> b
$ [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss [v]
us ANormal v
bd
| P.EffectPure p
_ Pattern p
q <- Pattern p
p =
(,)
([v] -> ANormal v -> ([v], ANormal v))
-> Compose (ANFM v) ((,) (Direction ())) [v]
-> Compose
(ANFM v) ((,) (Direction ())) (ANormal v -> ([v], ANormal v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern p] -> [v] -> Compose (ANFM v) ((,) (Direction ())) [v]
forall v p. Var v => [Pattern p] -> [v] -> ANFD v [v]
expandBindings [Pattern p
q] [v]
vs
Compose
(ANFM v) ((,) (Direction ())) (ANormal v -> ([v], ANormal v))
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) ([v], ANormal v)
forall a b.
Compose (ANFM v) ((,) (Direction ())) (a -> b)
-> Compose (ANFM v) ((,) (Direction ())) a
-> Compose (ANFM v) ((,) (Direction ())) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term v a -> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
anfBody Term v a
bd
Compose (ANFM v) ((,) (Direction ())) ([v], ANormal v)
-> (([v], ANormal v) -> BranchAccum v) -> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \([v]
us, ANormal v
bd) -> ANormal v -> BranchAccum v
forall v. ANormal v -> BranchAccum v
AccumPure (ANormal v -> BranchAccum v) -> ANormal v -> BranchAccum v
forall a b. (a -> b) -> a -> b
$ [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss [v]
us ANormal v
bd
| P.EffectBind p
_ (ConstructorReference Reference
r Word64
t) [Pattern p]
ps Pattern p
pk <- Pattern p
p = do
(,,)
([v] -> v -> ANormal v -> ([v], v, ANormal v))
-> Compose (ANFM v) ((,) (Direction ())) [v]
-> Compose
(ANFM v)
((,) (Direction ()))
(v -> ANormal v -> ([v], v, ANormal v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern p] -> [v] -> Compose (ANFM v) ((,) (Direction ())) [v]
forall v p. Var v => [Pattern p] -> [v] -> ANFD v [v]
expandBindings ([Pattern p] -> Pattern p -> [Pattern p]
forall s a. Snoc s s a a => s -> a -> s
snoc [Pattern p]
ps Pattern p
pk) [v]
vs
Compose
(ANFM v)
((,) (Direction ()))
(v -> ANormal v -> ([v], v, ANormal v))
-> Compose (ANFM v) ((,) (Direction ())) v
-> Compose
(ANFM v) ((,) (Direction ())) (ANormal v -> ([v], v, ANormal v))
forall a b.
Compose (ANFM v) ((,) (Direction ())) (a -> b)
-> Compose (ANFM v) ((,) (Direction ())) a
-> Compose (ANFM v) ((,) (Direction ())) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ANFM v (Directed () v) -> Compose (ANFM v) ((,) (Direction ())) v
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (v -> Directed () v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v -> Directed () v) -> ANFM v v -> ANFM v (Directed () v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ANFM v v
forall v. Var v => ANFM v v
fresh)
Compose
(ANFM v) ((,) (Direction ())) (ANormal v -> ([v], v, ANormal v))
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) ([v], v, ANormal v)
forall a b.
Compose (ANFM v) ((,) (Direction ())) (a -> b)
-> Compose (ANFM v) ((,) (Direction ())) a
-> Compose (ANFM v) ((,) (Direction ())) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term v a -> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
anfBody Term v a
bd
Compose (ANFM v) ((,) (Direction ())) ([v], v, ANormal v)
-> (([v], v, ANormal v) -> BranchAccum v) -> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \([v]
exp, v
kf, ANormal v
bd) ->
let ([v]
us, v
uk) =
([v], v) -> (([v], v) -> ([v], v)) -> Maybe ([v], v) -> ([v], v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ([v], v)
forall a. HasCallStack => String -> a
internalBug String
"anfInitCase: unsnoc impossible") ([v], v) -> ([v], v)
forall a. a -> a
id (Maybe ([v], v) -> ([v], v)) -> Maybe ([v], v) -> ([v], v)
forall a b. (a -> b) -> a -> b
$
[v] -> Maybe ([v], v)
forall s a. Snoc s s a a => s -> Maybe (s, a)
unsnoc [v]
exp
jn :: Reference' Text h
jn = Text -> Reference' Text h
forall t h. t -> Reference' t h
Builtin Text
"jumpCont"
in (Map Reference (EnumMap CTag ([Mem], ANormal v))
-> Maybe (ANormal v) -> BranchAccum v)
-> Maybe (ANormal v)
-> Map Reference (EnumMap CTag ([Mem], ANormal v))
-> BranchAccum v
forall a b c. (a -> b -> c) -> b -> a -> c
flip Map Reference (EnumMap CTag ([Mem], ANormal v))
-> Maybe (ANormal v) -> BranchAccum v
forall v.
Map Reference (EnumMap CTag ([Mem], ANormal v))
-> Maybe (ANormal v) -> BranchAccum v
AccumRequest Maybe (ANormal v)
forall a. Maybe a
Nothing
(Map Reference (EnumMap CTag ([Mem], ANormal v)) -> BranchAccum v)
-> (ANormal v -> Map Reference (EnumMap CTag ([Mem], ANormal v)))
-> ANormal v
-> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference
-> EnumMap CTag ([Mem], ANormal v)
-> Map Reference (EnumMap CTag ([Mem], ANormal v))
forall k a. k -> a -> Map k a
Map.singleton Reference
r
(EnumMap CTag ([Mem], ANormal v)
-> Map Reference (EnumMap CTag ([Mem], ANormal v)))
-> (ANormal v -> EnumMap CTag ([Mem], ANormal v))
-> ANormal v
-> Map Reference (EnumMap CTag ([Mem], ANormal v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTag -> ([Mem], ANormal v) -> EnumMap CTag ([Mem], ANormal v)
forall k a. EnumKey k => k -> a -> EnumMap k a
EC.mapSingleton (Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
t)
(([Mem], ANormal v) -> EnumMap CTag ([Mem], ANormal v))
-> (ANormal v -> ([Mem], ANormal v))
-> ANormal v
-> EnumMap CTag ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mem
BX Mem -> [v] -> [Mem]
forall a b. a -> [b] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [v]
us,)
(ANormal v -> ([Mem], ANormal v))
-> (ANormal v -> ANormal v) -> ANormal v -> ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss [v]
us
(ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> v -> ANormal v -> ANormal v
forall v.
Var v =>
Reference -> v -> Term ANormalF v -> Term ANormalF v
TShift Reference
r v
kf
(ANormal v -> BranchAccum v) -> ANormal v -> BranchAccum v
forall a b. (a -> b) -> a -> b
$ v -> Either Reference v -> [v] -> ANormal v -> ANormal v
forall v.
Var v =>
v
-> Either Reference v -> [v] -> Term ANormalF v -> Term ANormalF v
TName v
uk (Reference -> Either Reference v
forall a b. a -> Either a b
Left Reference
forall {h}. Reference' Text h
jn) [v
kf] ANormal v
bd
| P.SequenceLiteral p
_ [] <- Pattern p
p =
ANormal v -> BranchAccum v
forall v. ANormal v -> BranchAccum v
AccumSeqEmpty (ANormal v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a -> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
anfBody Term v a
bd
| P.SequenceOp p
_ Pattern p
l SeqOp
op Pattern p
r <- Pattern p
p,
SeqOp
Concat <- SeqOp
op,
P.SequenceLiteral p
p [Pattern p]
ll <- Pattern p
l = do
SeqEnd -> Int -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
forall v.
SeqEnd -> Int -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
AccumSeqSplit SeqEnd
SLeft ([Pattern p] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern p]
ll) Maybe (ANormal v)
forall a. Maybe a
Nothing
(ANormal v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss ([v] -> ANormal v -> ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) [v]
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern p] -> [v] -> Compose (ANFM v) ((,) (Direction ())) [v]
forall v p. Var v => [Pattern p] -> [v] -> ANFD v [v]
expandBindings [p -> Pattern p
forall loc. loc -> Pattern loc
P.Var p
p, Pattern p
r] [v]
vs Compose (ANFM v) ((,) (Direction ())) (ANormal v -> ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
forall a b.
Compose (ANFM v) ((,) (Direction ())) (a -> b)
-> Compose (ANFM v) ((,) (Direction ())) a
-> Compose (ANFM v) ((,) (Direction ())) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term v a -> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
anfBody Term v a
bd)
| P.SequenceOp p
_ Pattern p
l SeqOp
op Pattern p
r <- Pattern p
p,
SeqOp
Concat <- SeqOp
op,
P.SequenceLiteral p
p [Pattern p]
rl <- Pattern p
r =
SeqEnd -> Int -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
forall v.
SeqEnd -> Int -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
AccumSeqSplit SeqEnd
SLeft ([Pattern p] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern p]
rl) Maybe (ANormal v)
forall a. Maybe a
Nothing
(ANormal v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss ([v] -> ANormal v -> ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) [v]
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern p] -> [v] -> Compose (ANFM v) ((,) (Direction ())) [v]
forall v p. Var v => [Pattern p] -> [v] -> ANFD v [v]
expandBindings [Pattern p
l, p -> Pattern p
forall loc. loc -> Pattern loc
P.Var p
p] [v]
vs Compose (ANFM v) ((,) (Direction ())) (ANormal v -> ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
forall a b.
Compose (ANFM v) ((,) (Direction ())) (a -> b)
-> Compose (ANFM v) ((,) (Direction ())) a
-> Compose (ANFM v) ((,) (Direction ())) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term v a -> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
anfBody Term v a
bd)
| P.SequenceOp p
_ Pattern p
l SeqOp
op Pattern p
r <- Pattern p
p,
SeqEnd
dir <- case SeqOp
op of SeqOp
Cons -> SeqEnd
SLeft; SeqOp
_ -> SeqEnd
SRight =
SeqEnd -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
forall v. SeqEnd -> Maybe (ANormal v) -> ANormal v -> BranchAccum v
AccumSeqView SeqEnd
dir Maybe (ANormal v)
forall a. Maybe a
Nothing
(ANormal v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss ([v] -> ANormal v -> ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) [v]
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern p] -> [v] -> Compose (ANFM v) ((,) (Direction ())) [v]
forall v p. Var v => [Pattern p] -> [v] -> ANFD v [v]
expandBindings [Pattern p
l, Pattern p
r] [v]
vs Compose (ANFM v) ((,) (Direction ())) (ANormal v -> ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
forall a b.
Compose (ANFM v) ((,) (Direction ())) (a -> b)
-> Compose (ANFM v) ((,) (Direction ())) a
-> Compose (ANFM v) ((,) (Direction ())) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term v a -> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
anfBody Term v a
bd)
where
anfBody :: Term v a -> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
anfBody Term v a
tm = ReaderT
(Set v)
(StateT (Word64, Word16, [(v, SuperNormal v)]) Identity)
(Direction (), ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (ReaderT
(Set v)
(StateT (Word64, Word16, [(v, SuperNormal v)]) Identity)
(Direction (), ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v))
-> (ReaderT
(Set v)
(StateT (Word64, Word16, [(v, SuperNormal v)]) Identity)
(Direction (), ANormal v)
-> ReaderT
(Set v)
(StateT (Word64, Word16, [(v, SuperNormal v)]) Identity)
(Direction (), ANormal v))
-> ReaderT
(Set v)
(StateT (Word64, Word16, [(v, SuperNormal v)]) Identity)
(Direction (), ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v]
-> ReaderT
(Set v)
(StateT (Word64, Word16, [(v, SuperNormal v)]) Identity)
(Direction (), ANormal v)
-> ReaderT
(Set v)
(StateT (Word64, Word16, [(v, SuperNormal v)]) Identity)
(Direction (), ANormal v)
forall v r. Ord v => [v] -> ANFM v r -> ANFM v r
bindLocal [v]
vs (ReaderT
(Set v)
(StateT (Word64, Word16, [(v, SuperNormal v)]) Identity)
(Direction (), ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v))
-> ReaderT
(Set v)
(StateT (Word64, Word16, [(v, SuperNormal v)]) Identity)
(Direction (), ANormal v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal v)
forall a b. (a -> b) -> a -> b
$ Term v a
-> ReaderT
(Set v)
(StateT (Word64, Word16, [(v, SuperNormal v)]) Identity)
(Direction (), ANormal v)
forall v a. Var v => Term v a -> ANFM v (DNormal v)
anfTerm Term v a
tm
anfInitCase v
_ (MatchCase Pattern p
p Maybe (Term v a)
_ Term v a
_) =
String -> ANFD v (BranchAccum v)
forall a. HasCallStack => String -> a
internalBug (String -> ANFD v (BranchAccum v))
-> String -> ANFD v (BranchAccum v)
forall a b. (a -> b) -> a -> b
$ String
"anfInitCase: unexpected pattern: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Pattern p -> String
forall a. Show a => a -> String
show Pattern p
p
valueTermLinks :: Value -> [Reference]
valueTermLinks :: Value -> [Reference]
valueTermLinks = Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList (Set Reference -> [Reference])
-> (Value -> Set Reference) -> Value -> [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Reference -> Set Reference) -> Value -> Set Reference
forall a. Monoid a => (Bool -> Reference -> a) -> Value -> a
valueLinks Bool -> Reference -> Set Reference
forall {a}. Bool -> a -> Set a
f
where
f :: Bool -> a -> Set a
f Bool
False a
r = a -> Set a
forall a. a -> Set a
Set.singleton a
r
f Bool
_ a
_ = Set a
forall a. Set a
Set.empty
valueLinks :: (Monoid a) => (Bool -> Reference -> a) -> Value -> a
valueLinks :: forall a. Monoid a => (Bool -> Reference -> a) -> Value -> a
valueLinks Bool -> Reference -> a
f (Partial (GR Reference
cr Word64
_) [Word64]
_ [Value]
bs) =
Bool -> Reference -> a
f Bool
False Reference
cr a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (Value -> a) -> [Value] -> a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Bool -> Reference -> a) -> Value -> a
forall a. Monoid a => (Bool -> Reference -> a) -> Value -> a
valueLinks Bool -> Reference -> a
f) [Value]
bs
valueLinks Bool -> Reference -> a
f (Data Reference
dr Word64
_ [Word64]
_ [Value]
bs) =
Bool -> Reference -> a
f Bool
True Reference
dr a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (Value -> a) -> [Value] -> a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Bool -> Reference -> a) -> Value -> a
forall a. Monoid a => (Bool -> Reference -> a) -> Value -> a
valueLinks Bool -> Reference -> a
f) [Value]
bs
valueLinks Bool -> Reference -> a
f (Cont [Word64]
_ [Value]
bs Cont
k) =
(Value -> a) -> [Value] -> a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Bool -> Reference -> a) -> Value -> a
forall a. Monoid a => (Bool -> Reference -> a) -> Value -> a
valueLinks Bool -> Reference -> a
f) [Value]
bs a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (Bool -> Reference -> a) -> Cont -> a
forall a. Monoid a => (Bool -> Reference -> a) -> Cont -> a
contLinks Bool -> Reference -> a
f Cont
k
valueLinks Bool -> Reference -> a
f (BLit BLit
l) = (Bool -> Reference -> a) -> BLit -> a
forall a. Monoid a => (Bool -> Reference -> a) -> BLit -> a
blitLinks Bool -> Reference -> a
f BLit
l
contLinks :: (Monoid a) => (Bool -> Reference -> a) -> Cont -> a
contLinks :: forall a. Monoid a => (Bool -> Reference -> a) -> Cont -> a
contLinks Bool -> Reference -> a
f (Push Word64
_ Word64
_ Word64
_ Word64
_ (GR Reference
cr Word64
_) Cont
k) =
Bool -> Reference -> a
f Bool
False Reference
cr a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (Bool -> Reference -> a) -> Cont -> a
forall a. Monoid a => (Bool -> Reference -> a) -> Cont -> a
contLinks Bool -> Reference -> a
f Cont
k
contLinks Bool -> Reference -> a
f (Mark Word64
_ Word64
_ [Reference]
ps Map Reference Value
de Cont
k) =
(Reference -> a) -> [Reference] -> a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Bool -> Reference -> a
f Bool
True) [Reference]
ps
a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (Reference -> Value -> a) -> Map Reference Value -> a
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey (\Reference
k Value
c -> Bool -> Reference -> a
f Bool
True Reference
k a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (Bool -> Reference -> a) -> Value -> a
forall a. Monoid a => (Bool -> Reference -> a) -> Value -> a
valueLinks Bool -> Reference -> a
f Value
c) Map Reference Value
de
a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (Bool -> Reference -> a) -> Cont -> a
forall a. Monoid a => (Bool -> Reference -> a) -> Cont -> a
contLinks Bool -> Reference -> a
f Cont
k
contLinks Bool -> Reference -> a
_ Cont
KE = a
forall a. Monoid a => a
mempty
blitLinks :: (Monoid a) => (Bool -> Reference -> a) -> BLit -> a
blitLinks :: forall a. Monoid a => (Bool -> Reference -> a) -> BLit -> a
blitLinks Bool -> Reference -> a
f (List Seq Value
s) = (Value -> a) -> Seq Value -> a
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Bool -> Reference -> a) -> Value -> a
forall a. Monoid a => (Bool -> Reference -> a) -> Value -> a
valueLinks Bool -> Reference -> a
f) Seq Value
s
blitLinks Bool -> Reference -> a
_ BLit
_ = a
forall a. Monoid a => a
mempty
groupTermLinks :: (Var v) => SuperGroup v -> [Reference]
groupTermLinks :: forall v. Var v => SuperGroup v -> [Reference]
groupTermLinks = Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList (Set Reference -> [Reference])
-> (SuperGroup v -> Set Reference) -> SuperGroup v -> [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Reference -> Set Reference)
-> SuperGroup v -> Set Reference
forall r v.
(Monoid r, Var v) =>
(Bool -> Reference -> r) -> SuperGroup v -> r
foldGroupLinks Bool -> Reference -> Set Reference
forall {a}. Bool -> a -> Set a
f
where
f :: Bool -> a -> Set a
f Bool
False a
r = a -> Set a
forall a. a -> Set a
Set.singleton a
r
f Bool
_ a
_ = Set a
forall a. Set a
Set.empty
overGroupLinks ::
(Var v) =>
(Bool -> Reference -> Reference) ->
SuperGroup v ->
SuperGroup v
overGroupLinks :: forall v.
Var v =>
(Bool -> Reference -> Reference) -> SuperGroup v -> SuperGroup v
overGroupLinks Bool -> Reference -> Reference
f =
Identity (SuperGroup v) -> SuperGroup v
forall a. Identity a -> a
runIdentity (Identity (SuperGroup v) -> SuperGroup v)
-> (SuperGroup v -> Identity (SuperGroup v))
-> SuperGroup v
-> SuperGroup v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Reference -> Identity Reference)
-> SuperGroup v -> Identity (SuperGroup v)
forall (f :: * -> *) v.
(Applicative f, Var v) =>
(Bool -> Reference -> f Reference)
-> SuperGroup v -> f (SuperGroup v)
traverseGroupLinks (\Bool
b -> Reference -> Identity Reference
forall a. a -> Identity a
Identity (Reference -> Identity Reference)
-> (Reference -> Reference) -> Reference -> Identity Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Reference -> Reference
f Bool
b)
traverseGroupLinks ::
(Applicative f, Var v) =>
(Bool -> Reference -> f Reference) ->
SuperGroup v ->
f (SuperGroup v)
traverseGroupLinks :: forall (f :: * -> *) v.
(Applicative f, Var v) =>
(Bool -> Reference -> f Reference)
-> SuperGroup v -> f (SuperGroup v)
traverseGroupLinks Bool -> Reference -> f Reference
f (Rec [(v, SuperNormal v)]
bs SuperNormal v
e) =
[(v, SuperNormal v)] -> SuperNormal v -> SuperGroup v
forall v. [(v, SuperNormal v)] -> SuperNormal v -> SuperGroup v
Rec ([(v, SuperNormal v)] -> SuperNormal v -> SuperGroup v)
-> f [(v, SuperNormal v)] -> f (SuperNormal v -> SuperGroup v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((v, SuperNormal v) -> f (v, SuperNormal v))
-> [(v, SuperNormal v)] -> f [(v, SuperNormal v)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((v, SuperNormal v) -> f (v, SuperNormal v))
-> [(v, SuperNormal v)] -> f [(v, SuperNormal v)])
-> ((SuperNormal v -> f (SuperNormal v))
-> (v, SuperNormal v) -> f (v, SuperNormal v))
-> (SuperNormal v -> f (SuperNormal v))
-> [(v, SuperNormal v)]
-> f [(v, SuperNormal v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperNormal v -> f (SuperNormal v))
-> (v, SuperNormal v) -> f (v, SuperNormal v)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (v, a) -> f (v, b)
traverse) ((Bool -> Reference -> f Reference)
-> SuperNormal v -> f (SuperNormal v)
forall (f :: * -> *) v.
(Applicative f, Var v) =>
(Bool -> Reference -> f Reference)
-> SuperNormal v -> f (SuperNormal v)
normalLinks Bool -> Reference -> f Reference
f) [(v, SuperNormal v)]
bs f (SuperNormal v -> SuperGroup v)
-> f (SuperNormal v) -> f (SuperGroup v)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Reference -> f Reference)
-> SuperNormal v -> f (SuperNormal v)
forall (f :: * -> *) v.
(Applicative f, Var v) =>
(Bool -> Reference -> f Reference)
-> SuperNormal v -> f (SuperNormal v)
normalLinks Bool -> Reference -> f Reference
f SuperNormal v
e
foldGroupLinks ::
(Monoid r, Var v) =>
(Bool -> Reference -> r) ->
SuperGroup v ->
r
foldGroupLinks :: forall r v.
(Monoid r, Var v) =>
(Bool -> Reference -> r) -> SuperGroup v -> r
foldGroupLinks Bool -> Reference -> r
f = Const r (SuperGroup v) -> r
forall {k} a (b :: k). Const a b -> a
getConst (Const r (SuperGroup v) -> r)
-> (SuperGroup v -> Const r (SuperGroup v)) -> SuperGroup v -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Reference -> Const r Reference)
-> SuperGroup v -> Const r (SuperGroup v)
forall (f :: * -> *) v.
(Applicative f, Var v) =>
(Bool -> Reference -> f Reference)
-> SuperGroup v -> f (SuperGroup v)
traverseGroupLinks (\Bool
b -> r -> Const r Reference
forall {k} a (b :: k). a -> Const a b
Const (r -> Const r Reference)
-> (Reference -> r) -> Reference -> Const r Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Reference -> r
f Bool
b)
normalLinks ::
(Applicative f, Var v) =>
(Bool -> Reference -> f Reference) ->
SuperNormal v ->
f (SuperNormal v)
normalLinks :: forall (f :: * -> *) v.
(Applicative f, Var v) =>
(Bool -> Reference -> f Reference)
-> SuperNormal v -> f (SuperNormal v)
normalLinks Bool -> Reference -> f Reference
f (Lambda [Mem]
ccs ANormal v
e) = [Mem] -> ANormal v -> SuperNormal v
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda [Mem]
ccs (ANormal v -> SuperNormal v) -> f (ANormal v) -> f (SuperNormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Reference -> f Reference) -> ANormal v -> f (ANormal v)
forall (f :: * -> *) v.
(Applicative f, Var v) =>
(Bool -> Reference -> f Reference) -> ANormal v -> f (ANormal v)
anfLinks Bool -> Reference -> f Reference
f ANormal v
e
anfLinks ::
(Applicative f, Var v) =>
(Bool -> Reference -> f Reference) ->
ANormal v ->
f (ANormal v)
anfLinks :: forall (f :: * -> *) v.
(Applicative f, Var v) =>
(Bool -> Reference -> f Reference) -> ANormal v -> f (ANormal v)
anfLinks Bool -> Reference -> f Reference
f (ABTN.Term Set v
_ (ABTN.Abs v
v Term ANormalF v
e)) =
v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
ABTN.TAbs v
v (Term ANormalF v -> Term ANormalF v)
-> f (Term ANormalF v) -> f (Term ANormalF v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Reference -> f Reference)
-> Term ANormalF v -> f (Term ANormalF v)
forall (f :: * -> *) v.
(Applicative f, Var v) =>
(Bool -> Reference -> f Reference) -> ANormal v -> f (ANormal v)
anfLinks Bool -> Reference -> f Reference
f Term ANormalF v
e
anfLinks Bool -> Reference -> f Reference
f (ABTN.Term Set v
_ (ABTN.Tm ANormalF v (Term ANormalF v)
e)) =
ANormalF v (Term ANormalF v) -> Term ANormalF v
forall v (f :: * -> * -> *).
(Var v, Bifoldable f) =>
f v (Term f v) -> Term f v
ABTN.TTm (ANormalF v (Term ANormalF v) -> Term ANormalF v)
-> f (ANormalF v (Term ANormalF v)) -> f (Term ANormalF v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Reference -> f Reference)
-> (Term ANormalF v -> f (Term ANormalF v))
-> ANormalF v (Term ANormalF v)
-> f (ANormalF v (Term ANormalF v))
forall (f :: * -> *) e v.
Applicative f =>
(Bool -> Reference -> f Reference)
-> (e -> f e) -> ANormalF v e -> f (ANormalF v e)
anfFLinks Bool -> Reference -> f Reference
f ((Bool -> Reference -> f Reference)
-> Term ANormalF v -> f (Term ANormalF v)
forall (f :: * -> *) v.
(Applicative f, Var v) =>
(Bool -> Reference -> f Reference) -> ANormal v -> f (ANormal v)
anfLinks Bool -> Reference -> f Reference
f) ANormalF v (Term ANormalF v)
e
anfFLinks ::
(Applicative f) =>
(Bool -> Reference -> f Reference) ->
(e -> f e) ->
ANormalF v e ->
f (ANormalF v e)
anfFLinks :: forall (f :: * -> *) e v.
Applicative f =>
(Bool -> Reference -> f Reference)
-> (e -> f e) -> ANormalF v e -> f (ANormalF v e)
anfFLinks Bool -> Reference -> f Reference
_ e -> f e
g (ALet Direction Word16
d [Mem]
ccs e
b e
e) = Direction Word16 -> [Mem] -> e -> e -> ANormalF v e
forall v e. Direction Word16 -> [Mem] -> e -> e -> ANormalF v e
ALet Direction Word16
d [Mem]
ccs (e -> e -> ANormalF v e) -> f e -> f (e -> ANormalF v e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> f e
g e
b f (e -> ANormalF v e) -> f e -> f (ANormalF v e)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> f e
g e
e
anfFLinks Bool -> Reference -> f Reference
f e -> f e
g (AName Either Reference v
er [v]
vs e
e) =
(Either Reference v -> [v] -> e -> ANormalF v e)
-> [v] -> Either Reference v -> e -> ANormalF v e
forall a b c. (a -> b -> c) -> b -> a -> c
flip Either Reference v -> [v] -> e -> ANormalF v e
forall v e. Either Reference v -> [v] -> e -> ANormalF v e
AName [v]
vs (Either Reference v -> e -> ANormalF v e)
-> f (Either Reference v) -> f (e -> ANormalF v e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference -> f Reference)
-> (v -> f v) -> Either Reference v -> f (Either Reference v)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Either a b -> f (Either c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Bool -> Reference -> f Reference
f Bool
False) v -> f v
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either Reference v
er f (e -> ANormalF v e) -> f e -> f (ANormalF v e)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> f e
g e
e
anfFLinks Bool -> Reference -> f Reference
f e -> f e
g (AMatch v
v Branched e
bs) =
v -> Branched e -> ANormalF v e
forall v e. v -> Branched e -> ANormalF v e
AMatch v
v (Branched e -> ANormalF v e) -> f (Branched e) -> f (ANormalF v e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference -> f Reference)
-> (e -> f e) -> Branched e -> f (Branched e)
forall (f :: * -> *) e.
Applicative f =>
(Reference -> f Reference)
-> (e -> f e) -> Branched e -> f (Branched e)
branchLinks (Bool -> Reference -> f Reference
f Bool
True) e -> f e
g Branched e
bs
anfFLinks Bool -> Reference -> f Reference
f e -> f e
g (AShift Reference
r e
e) =
Reference -> e -> ANormalF v e
forall v e. Reference -> e -> ANormalF v e
AShift (Reference -> e -> ANormalF v e)
-> f Reference -> f (e -> ANormalF v e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Reference -> f Reference
f Bool
True Reference
r f (e -> ANormalF v e) -> f e -> f (ANormalF v e)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> f e
g e
e
anfFLinks Bool -> Reference -> f Reference
f e -> f e
g (AHnd [Reference]
rs v
v e
e) =
([Reference] -> v -> e -> ANormalF v e)
-> v -> [Reference] -> e -> ANormalF v e
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Reference] -> v -> e -> ANormalF v e
forall v e. [Reference] -> v -> e -> ANormalF v e
AHnd v
v ([Reference] -> e -> ANormalF v e)
-> f [Reference] -> f (e -> ANormalF v e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference -> f Reference) -> [Reference] -> f [Reference]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Bool -> Reference -> f Reference
f Bool
True) [Reference]
rs f (e -> ANormalF v e) -> f e -> f (ANormalF v e)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> f e
g e
e
anfFLinks Bool -> Reference -> f Reference
f e -> f e
_ (AApp Func v
fu [v]
vs) = (Func v -> [v] -> ANormalF v e) -> [v] -> Func v -> ANormalF v e
forall a b c. (a -> b -> c) -> b -> a -> c
flip Func v -> [v] -> ANormalF v e
forall v e. Func v -> [v] -> ANormalF v e
AApp [v]
vs (Func v -> ANormalF v e) -> f (Func v) -> f (ANormalF v e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Reference -> f Reference) -> Func v -> f (Func v)
forall (f :: * -> *) v.
Applicative f =>
(Bool -> Reference -> f Reference) -> Func v -> f (Func v)
funcLinks Bool -> Reference -> f Reference
f Func v
fu
anfFLinks Bool -> Reference -> f Reference
f e -> f e
_ (ALit Lit
l) = Lit -> ANormalF v e
forall v e. Lit -> ANormalF v e
ALit (Lit -> ANormalF v e) -> f Lit -> f (ANormalF v e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Reference -> f Reference) -> Lit -> f Lit
forall (f :: * -> *).
Applicative f =>
(Bool -> Reference -> f Reference) -> Lit -> f Lit
litLinks Bool -> Reference -> f Reference
f Lit
l
anfFLinks Bool -> Reference -> f Reference
_ e -> f e
_ ANormalF v e
v = ANormalF v e -> f (ANormalF v e)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ANormalF v e
v
litLinks ::
(Applicative f) =>
(Bool -> Reference -> f Reference) ->
Lit ->
f Lit
litLinks :: forall (f :: * -> *).
Applicative f =>
(Bool -> Reference -> f Reference) -> Lit -> f Lit
litLinks Bool -> Reference -> f Reference
f (LY Reference
r) = Reference -> Lit
LY (Reference -> Lit) -> f Reference -> f Lit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Reference -> f Reference
f Bool
True Reference
r
litLinks Bool -> Reference -> f Reference
f (LM (Con (ConstructorReference Reference
r Word64
i) ConstructorType
t)) =
Referent -> Lit
LM (Referent -> Lit) -> (Reference -> Referent) -> Reference -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstructorReference -> ConstructorType -> Referent)
-> ConstructorType -> ConstructorReference -> Referent
forall a b c. (a -> b -> c) -> b -> a -> c
flip ConstructorReference -> ConstructorType -> Referent
Con ConstructorType
t (ConstructorReference -> Referent)
-> (Reference -> ConstructorReference) -> Reference -> Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> Word64 -> ConstructorReference)
-> Word64 -> Reference -> ConstructorReference
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reference -> Word64 -> ConstructorReference
forall r. r -> Word64 -> GConstructorReference r
ConstructorReference Word64
i (Reference -> Lit) -> f Reference -> f Lit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Reference -> f Reference
f Bool
True Reference
r
litLinks Bool -> Reference -> f Reference
f (LM (Ref Reference
r)) = Referent -> Lit
LM (Referent -> Lit) -> (Reference -> Referent) -> Reference -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Referent
Ref (Reference -> Lit) -> f Reference -> f Lit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Reference -> f Reference
f Bool
False Reference
r
litLinks Bool -> Reference -> f Reference
_ Lit
v = Lit -> f Lit
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Lit
v
branchLinks ::
(Applicative f) =>
(Reference -> f Reference) ->
(e -> f e) ->
Branched e ->
f (Branched e)
branchLinks :: forall (f :: * -> *) e.
Applicative f =>
(Reference -> f Reference)
-> (e -> f e) -> Branched e -> f (Branched e)
branchLinks Reference -> f Reference
f e -> f e
g (MatchRequest Map Reference (EnumMap CTag ([Mem], e))
m e
e) =
Map Reference (EnumMap CTag ([Mem], e)) -> e -> Branched e
forall e.
Map Reference (EnumMap CTag ([Mem], e)) -> e -> Branched e
MatchRequest (Map Reference (EnumMap CTag ([Mem], e)) -> e -> Branched e)
-> ([(Reference, EnumMap CTag ([Mem], e))]
-> Map Reference (EnumMap CTag ([Mem], e)))
-> [(Reference, EnumMap CTag ([Mem], e))]
-> e
-> Branched e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Reference, EnumMap CTag ([Mem], e))]
-> Map Reference (EnumMap CTag ([Mem], e))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
([(Reference, EnumMap CTag ([Mem], e))] -> e -> Branched e)
-> f [(Reference, EnumMap CTag ([Mem], e))] -> f (e -> Branched e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Reference, EnumMap CTag ([Mem], e))
-> f (Reference, EnumMap CTag ([Mem], e)))
-> [(Reference, EnumMap CTag ([Mem], e))]
-> f [(Reference, EnumMap CTag ([Mem], e))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Reference -> f Reference)
-> (EnumMap CTag ([Mem], e) -> f (EnumMap CTag ([Mem], e)))
-> (Reference, EnumMap CTag ([Mem], e))
-> f (Reference, EnumMap CTag ([Mem], e))
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Reference -> f Reference
f ((EnumMap CTag ([Mem], e) -> f (EnumMap CTag ([Mem], e)))
-> (Reference, EnumMap CTag ([Mem], e))
-> f (Reference, EnumMap CTag ([Mem], e)))
-> (EnumMap CTag ([Mem], e) -> f (EnumMap CTag ([Mem], e)))
-> (Reference, EnumMap CTag ([Mem], e))
-> f (Reference, EnumMap CTag ([Mem], e))
forall a b. (a -> b) -> a -> b
$ ((([Mem], e) -> f ([Mem], e))
-> EnumMap CTag ([Mem], e) -> f (EnumMap CTag ([Mem], e))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EnumMap CTag a -> f (EnumMap CTag b)
traverse ((([Mem], e) -> f ([Mem], e))
-> EnumMap CTag ([Mem], e) -> f (EnumMap CTag ([Mem], e)))
-> ((e -> f e) -> ([Mem], e) -> f ([Mem], e))
-> (e -> f e)
-> EnumMap CTag ([Mem], e)
-> f (EnumMap CTag ([Mem], e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> f e) -> ([Mem], e) -> f ([Mem], e)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ([Mem], a) -> f ([Mem], b)
traverse) e -> f e
g) (Map Reference (EnumMap CTag ([Mem], e))
-> [(Reference, EnumMap CTag ([Mem], e))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Reference (EnumMap CTag ([Mem], e))
m)
f (e -> Branched e) -> f e -> f (Branched e)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> f e
g e
e
branchLinks Reference -> f Reference
f e -> f e
g (MatchData Reference
r EnumMap CTag ([Mem], e)
m Maybe e
e) =
Reference -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched e
forall e.
Reference -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched e
MatchData (Reference -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched e)
-> f Reference
-> f (EnumMap CTag ([Mem], e) -> Maybe e -> Branched e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reference -> f Reference
f Reference
r f (EnumMap CTag ([Mem], e) -> Maybe e -> Branched e)
-> f (EnumMap CTag ([Mem], e)) -> f (Maybe e -> Branched e)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((([Mem], e) -> f ([Mem], e))
-> EnumMap CTag ([Mem], e) -> f (EnumMap CTag ([Mem], e))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EnumMap CTag a -> f (EnumMap CTag b)
traverse ((([Mem], e) -> f ([Mem], e))
-> EnumMap CTag ([Mem], e) -> f (EnumMap CTag ([Mem], e)))
-> ((e -> f e) -> ([Mem], e) -> f ([Mem], e))
-> (e -> f e)
-> EnumMap CTag ([Mem], e)
-> f (EnumMap CTag ([Mem], e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> f e) -> ([Mem], e) -> f ([Mem], e)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ([Mem], a) -> f ([Mem], b)
traverse) e -> f e
g EnumMap CTag ([Mem], e)
m f (Maybe e -> Branched e) -> f (Maybe e) -> f (Branched e)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (e -> f e) -> Maybe e -> f (Maybe e)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse e -> f e
g Maybe e
e
branchLinks Reference -> f Reference
_ e -> f e
g (MatchText Map Text e
m Maybe e
e) =
Map Text e -> Maybe e -> Branched e
forall e. Map Text e -> Maybe e -> Branched e
MatchText (Map Text e -> Maybe e -> Branched e)
-> f (Map Text e) -> f (Maybe e -> Branched e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (e -> f e) -> Map Text e -> f (Map Text e)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Text a -> f (Map Text b)
traverse e -> f e
g Map Text e
m f (Maybe e -> Branched e) -> f (Maybe e) -> f (Branched e)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (e -> f e) -> Maybe e -> f (Maybe e)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse e -> f e
g Maybe e
e
branchLinks Reference -> f Reference
_ e -> f e
g (MatchIntegral EnumMap Word64 e
m Maybe e
e) =
EnumMap Word64 e -> Maybe e -> Branched e
forall e. EnumMap Word64 e -> Maybe e -> Branched e
MatchIntegral (EnumMap Word64 e -> Maybe e -> Branched e)
-> f (EnumMap Word64 e) -> f (Maybe e -> Branched e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (e -> f e) -> EnumMap Word64 e -> f (EnumMap Word64 e)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EnumMap Word64 a -> f (EnumMap Word64 b)
traverse e -> f e
g EnumMap Word64 e
m f (Maybe e -> Branched e) -> f (Maybe e) -> f (Branched e)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (e -> f e) -> Maybe e -> f (Maybe e)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse e -> f e
g Maybe e
e
branchLinks Reference -> f Reference
_ e -> f e
g (MatchNumeric Reference
r EnumMap Word64 e
m Maybe e
e) =
Reference -> EnumMap Word64 e -> Maybe e -> Branched e
forall e. Reference -> EnumMap Word64 e -> Maybe e -> Branched e
MatchNumeric Reference
r (EnumMap Word64 e -> Maybe e -> Branched e)
-> f (EnumMap Word64 e) -> f (Maybe e -> Branched e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (e -> f e) -> EnumMap Word64 e -> f (EnumMap Word64 e)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EnumMap Word64 a -> f (EnumMap Word64 b)
traverse e -> f e
g EnumMap Word64 e
m f (Maybe e -> Branched e) -> f (Maybe e) -> f (Branched e)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (e -> f e) -> Maybe e -> f (Maybe e)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse e -> f e
g Maybe e
e
branchLinks Reference -> f Reference
_ e -> f e
g (MatchSum EnumMap Word64 ([Mem], e)
m) =
EnumMap Word64 ([Mem], e) -> Branched e
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], e) -> Branched e)
-> f (EnumMap Word64 ([Mem], e)) -> f (Branched e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((([Mem], e) -> f ([Mem], e))
-> EnumMap Word64 ([Mem], e) -> f (EnumMap Word64 ([Mem], e))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EnumMap Word64 a -> f (EnumMap Word64 b)
traverse ((([Mem], e) -> f ([Mem], e))
-> EnumMap Word64 ([Mem], e) -> f (EnumMap Word64 ([Mem], e)))
-> ((e -> f e) -> ([Mem], e) -> f ([Mem], e))
-> (e -> f e)
-> EnumMap Word64 ([Mem], e)
-> f (EnumMap Word64 ([Mem], e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> f e) -> ([Mem], e) -> f ([Mem], e)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ([Mem], a) -> f ([Mem], b)
traverse) e -> f e
g EnumMap Word64 ([Mem], e)
m
branchLinks Reference -> f Reference
_ e -> f e
_ Branched e
MatchEmpty = Branched e -> f (Branched e)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Branched e
forall e. Branched e
MatchEmpty
funcLinks ::
(Applicative f) =>
(Bool -> Reference -> f Reference) ->
Func v ->
f (Func v)
funcLinks :: forall (f :: * -> *) v.
Applicative f =>
(Bool -> Reference -> f Reference) -> Func v -> f (Func v)
funcLinks Bool -> Reference -> f Reference
f (FComb Reference
r) = Reference -> Func v
forall v. Reference -> Func v
FComb (Reference -> Func v) -> f Reference -> f (Func v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Reference -> f Reference
f Bool
False Reference
r
funcLinks Bool -> Reference -> f Reference
f (FCon Reference
r CTag
t) = (Reference -> CTag -> Func v) -> CTag -> Reference -> Func v
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reference -> CTag -> Func v
forall v. Reference -> CTag -> Func v
FCon CTag
t (Reference -> Func v) -> f Reference -> f (Func v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Reference -> f Reference
f Bool
True Reference
r
funcLinks Bool -> Reference -> f Reference
f (FReq Reference
r CTag
t) = (Reference -> CTag -> Func v) -> CTag -> Reference -> Func v
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reference -> CTag -> Func v
forall v. Reference -> CTag -> Func v
FReq CTag
t (Reference -> Func v) -> f Reference -> f (Func v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Reference -> f Reference
f Bool
True Reference
r
funcLinks Bool -> Reference -> f Reference
_ Func v
ff = Func v -> f (Func v)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Func v
ff
expandBindings' ::
(Var v) =>
Word64 ->
[P.Pattern p] ->
[v] ->
Either String (Word64, [v])
expandBindings' :: forall v p.
Var v =>
Word64 -> [Pattern p] -> [v] -> Either String (Word64, [v])
expandBindings' Word64
fr [] [] = (Word64, [v]) -> Either String (Word64, [v])
forall a b. b -> Either a b
Right (Word64
fr, [])
expandBindings' Word64
fr (P.Unbound p
_ : [Pattern p]
ps) [v]
vs =
([v] -> [v]) -> (Word64, [v]) -> (Word64, [v])
forall a b. (a -> b) -> (Word64, a) -> (Word64, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v
u v -> [v] -> [v]
forall a. a -> [a] -> [a]
:) ((Word64, [v]) -> (Word64, [v]))
-> Either String (Word64, [v]) -> Either String (Word64, [v])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> [Pattern p] -> [v] -> Either String (Word64, [v])
forall v p.
Var v =>
Word64 -> [Pattern p] -> [v] -> Either String (Word64, [v])
expandBindings' (Word64
fr Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) [Pattern p]
ps [v]
vs
where
u :: v
u = Word64 -> v
forall v. Var v => Word64 -> v
freshANF Word64
fr
expandBindings' Word64
fr (P.Var p
_ : [Pattern p]
ps) (v
v : [v]
vs) =
([v] -> [v]) -> (Word64, [v]) -> (Word64, [v])
forall a b. (a -> b) -> (Word64, a) -> (Word64, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
:) ((Word64, [v]) -> (Word64, [v]))
-> Either String (Word64, [v]) -> Either String (Word64, [v])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> [Pattern p] -> [v] -> Either String (Word64, [v])
forall v p.
Var v =>
Word64 -> [Pattern p] -> [v] -> Either String (Word64, [v])
expandBindings' Word64
fr [Pattern p]
ps [v]
vs
expandBindings' Word64
_ [] (v
_ : [v]
_) =
String -> Either String (Word64, [v])
forall a b. a -> Either a b
Left String
"expandBindings': more bindings than expected"
expandBindings' Word64
_ (Pattern p
_ : [Pattern p]
_) [] =
String -> Either String (Word64, [v])
forall a b. a -> Either a b
Left String
"expandBindings': more patterns than expected"
expandBindings' Word64
_ [Pattern p]
_ [v]
_ =
String -> Either String (Word64, [v])
forall a b. a -> Either a b
Left (String -> Either String (Word64, [v]))
-> String -> Either String (Word64, [v])
forall a b. (a -> b) -> a -> b
$ String
"expandBindings': unexpected pattern"
expandBindings :: (Var v) => [P.Pattern p] -> [v] -> ANFD v [v]
expandBindings :: forall v p. Var v => [Pattern p] -> [v] -> ANFD v [v]
expandBindings [Pattern p]
ps [v]
vs =
ANFM v (Directed () [v])
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
[v]
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (ANFM v (Directed () [v])
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
[v])
-> (((Word64, Word16, [(v, SuperNormal v)])
-> (Directed () [v], (Word64, Word16, [(v, SuperNormal v)])))
-> ANFM v (Directed () [v]))
-> ((Word64, Word16, [(v, SuperNormal v)])
-> (Directed () [v], (Word64, Word16, [(v, SuperNormal v)])))
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
[v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, Word16, [(v, SuperNormal v)])
-> (Directed () [v], (Word64, Word16, [(v, SuperNormal v)])))
-> ANFM v (Directed () [v])
forall a.
((Word64, Word16, [(v, SuperNormal v)])
-> (a, (Word64, Word16, [(v, SuperNormal v)])))
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (((Word64, Word16, [(v, SuperNormal v)])
-> (Directed () [v], (Word64, Word16, [(v, SuperNormal v)])))
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
[v])
-> ((Word64, Word16, [(v, SuperNormal v)])
-> (Directed () [v], (Word64, Word16, [(v, SuperNormal v)])))
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
[v]
forall a b. (a -> b) -> a -> b
$ \(Word64
fr, Word16
bnd, [(v, SuperNormal v)]
co) -> case Word64 -> [Pattern p] -> [v] -> Either String (Word64, [v])
forall v p.
Var v =>
Word64 -> [Pattern p] -> [v] -> Either String (Word64, [v])
expandBindings' Word64
fr [Pattern p]
ps [v]
vs of
Left String
err -> String -> (Directed () [v], (Word64, Word16, [(v, SuperNormal v)]))
forall a. HasCallStack => String -> a
internalBug (String
-> (Directed () [v], (Word64, Word16, [(v, SuperNormal v)])))
-> String
-> (Directed () [v], (Word64, Word16, [(v, SuperNormal v)]))
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Pattern p], [v]) -> String
forall a. Show a => a -> String
show ([Pattern p]
ps, [v]
vs)
Right (Word64
fr, [v]
l) -> ([v] -> Directed () [v]
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [v]
l, (Word64
fr, Word16
bnd, [(v, SuperNormal v)]
co))
anfCases ::
(Var v) =>
v ->
[MatchCase p (Term v a)] ->
ANFM v (Directed () (BranchAccum v))
anfCases :: forall v p a.
Var v =>
v
-> [MatchCase p (Term v a)] -> ANFM v (Directed () (BranchAccum v))
anfCases v
u = Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
(BranchAccum v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Direction (), BranchAccum v)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
(BranchAccum v)
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Direction (), BranchAccum v))
-> ([MatchCase p (Term v a)]
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
(BranchAccum v))
-> [MatchCase p (Term v a)]
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Direction (), BranchAccum v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([BranchAccum v] -> BranchAccum v)
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
[BranchAccum v]
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
(BranchAccum v)
forall a b.
(a -> b)
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
a
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [BranchAccum v] -> BranchAccum v
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
[BranchAccum v]
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
(BranchAccum v))
-> ([MatchCase p (Term v a)]
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
[BranchAccum v])
-> [MatchCase p (Term v a)]
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
(BranchAccum v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MatchCase p (Term v a)
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
(BranchAccum v))
-> [MatchCase p (Term v a)]
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
[BranchAccum v]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (v
-> MatchCase p (Term v a)
-> Compose
(ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])))
((,) (Direction ()))
(BranchAccum v)
forall v p a.
Var v =>
v -> MatchCase p (Term v a) -> ANFD v (BranchAccum v)
anfInitCase v
u)
anfFunc :: (Var v) => Term v a -> ANFM v (Ctx v, Directed () (Func v))
anfFunc :: forall v a.
Var v =>
Term v a -> ANFM v (Ctx v, Directed () (Func v))
anfFunc (Var' v
v) = (Ctx v, Directed () (Func v))
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, Directed () (Func v))
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, (() -> Direction ()
forall a. a -> Direction a
Indirect (), v -> Func v
forall v. v -> Func v
FVar v
v))
anfFunc (Ref' Reference
r) = (Ctx v, Directed () (Func v))
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, Directed () (Func v))
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, (() -> Direction ()
forall a. a -> Direction a
Indirect (), Reference -> Func v
forall v. Reference -> Func v
FComb Reference
r))
anfFunc (Constructor' (ConstructorReference Reference
r Word64
t)) = (Ctx v, Directed () (Func v))
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, Directed () (Func v))
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, (Direction ()
forall a. Direction a
Direct, Reference -> CTag -> Func v
forall v. Reference -> CTag -> Func v
FCon Reference
r (CTag -> Func v) -> CTag -> Func v
forall a b. (a -> b) -> a -> b
$ Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
t))
anfFunc (Request' (ConstructorReference Reference
r Word64
t)) = (Ctx v, Directed () (Func v))
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, Directed () (Func v))
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, (() -> Direction ()
forall a. a -> Direction a
Indirect (), Reference -> CTag -> Func v
forall v. Reference -> CTag -> Func v
FReq Reference
r (CTag -> Func v) -> CTag -> Func v
forall a b. (a -> b) -> a -> b
$ Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
t))
anfFunc Term (F v a a) v a
tm = do
(Ctx v
fctx, DNormal v
ctm) <- Term (F v a a) v a -> ANFM v (Ctx v, DNormal v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term (F v a a) v a
tm
(Ctx v
cx, v
v) <- DNormal v -> ANFM v (Ctx v, v)
forall v. Var v => DNormal v -> ANFM v (Ctx v, v)
contextualize DNormal v
ctm
(Ctx v, Directed () (Func v))
-> ReaderT
(Set v)
(State (Word64, Word16, [(v, SuperNormal v)]))
(Ctx v, Directed () (Func v))
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
fctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx, (() -> Direction ()
forall a. a -> Direction a
Indirect (), v -> Func v
forall v. v -> Func v
FVar v
v))
anfArg :: (Var v) => Term v a -> ANFM v (Ctx v, v)
anfArg :: forall v a. Var v => Term v a -> ANFM v (Ctx v, v)
anfArg Term v a
tm = do
(Ctx v
ctx, DNormal v
ctm) <- Term v a -> ANFM v (Ctx v, DNormal v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
tm
(Ctx v
cx, v
v) <- DNormal v -> ANFM v (Ctx v, v)
forall v. Var v => DNormal v -> ANFM v (Ctx v, v)
contextualize DNormal v
ctm
(Ctx v, v) -> ANFM v (Ctx v, v)
forall a.
a
-> ReaderT (Set v) (State (Word64, Word16, [(v, SuperNormal v)])) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
ctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx, v
v)
anfArgs :: (Var v) => [Term v a] -> ANFM v (Ctx v, [v])
anfArgs :: forall v a. Var v => [Term v a] -> ANFM v (Ctx v, [v])
anfArgs [Term v a]
tms = ([Ctx v] -> Ctx v) -> ([Ctx v], [v]) -> (Ctx v, [v])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Ctx v] -> Ctx v
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (([Ctx v], [v]) -> (Ctx v, [v]))
-> ([(Ctx v, v)] -> ([Ctx v], [v])) -> [(Ctx v, v)] -> (Ctx v, [v])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Ctx v, v)] -> ([Ctx v], [v])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Ctx v, v)] -> (Ctx v, [v]))
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) [(Ctx v, v)]
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) (Ctx v, [v])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term v a
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) (Ctx v, v))
-> [Term v a]
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) [(Ctx v, v)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Term v a
-> ReaderT
(Set v) (State (Word64, Word16, [(v, SuperNormal v)])) (Ctx v, v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, v)
anfArg [Term v a]
tms
indent :: Int -> ShowS
indent :: Int -> ShowS
indent Int
ind = String -> ShowS
showString (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Char
' ')
prettyGroup :: (Var v) => String -> SuperGroup v -> ShowS
prettyGroup :: forall v. Var v => String -> SuperGroup v -> ShowS
prettyGroup String
s (Rec [(v, SuperNormal v)]
grp SuperNormal v
ent) =
String -> ShowS
showString (String
"let rec[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]\n")
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v, SuperNormal v) -> ShowS -> ShowS)
-> ShowS -> [(v, SuperNormal v)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (v, SuperNormal v) -> ShowS -> ShowS
forall {v} {v} {a}.
(Var v, Var v) =>
(v, SuperNormal v) -> (a -> String) -> a -> String
f ShowS
forall a. a -> a
id [(v, SuperNormal v)]
grp
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"entry"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SuperNormal v -> ShowS
forall v. Var v => Int -> SuperNormal v -> ShowS
prettySuperNormal Int
1 SuperNormal v
ent
where
f :: (v, SuperNormal v) -> (a -> String) -> a -> String
f (v
v, SuperNormal v
sn) a -> String
r =
Int -> ShowS
indent Int
1
ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v
ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SuperNormal v -> ShowS
forall v. Var v => Int -> SuperNormal v -> ShowS
prettySuperNormal Int
2 SuperNormal v
sn
ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\n"
ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
r
pvar :: (Var v) => v -> ShowS
pvar :: forall v. Var v => v -> ShowS
pvar v
v = String -> ShowS
showString (String -> ShowS) -> (Text -> String) -> Text -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Data.Text.unpack (Text -> ShowS) -> Text -> ShowS
forall a b. (a -> b) -> a -> b
$ v -> Text
forall v. Var v => v -> Text
Var.name v
v
prettyVars :: (Var v) => [v] -> ShowS
prettyVars :: forall v. Var v => [v] -> ShowS
prettyVars =
(v -> ShowS -> ShowS) -> ShowS -> [v] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\v
v ShowS
r -> String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r) ShowS
forall a. a -> a
id
prettyLVars :: (Var v) => [Mem] -> [v] -> ShowS
prettyLVars :: forall v. Var v => [Mem] -> [v] -> ShowS
prettyLVars [] [] = String -> ShowS
showString String
" "
prettyLVars (Mem
c : [Mem]
cs) (v
v : [v]
vs) =
String -> ShowS
showString String
" "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ShowS -> ShowS
showParen Bool
True (v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
":" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mem -> ShowS
forall a. Show a => a -> ShowS
shows Mem
c)
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Mem] -> [v] -> ShowS
forall v. Var v => [Mem] -> [v] -> ShowS
prettyLVars [Mem]
cs [v]
vs
prettyLVars [] (v
_ : [v]
_) = String -> ShowS
forall a. HasCallStack => String -> a
internalBug String
"more variables than conventions"
prettyLVars (Mem
_ : [Mem]
_) [] = String -> ShowS
forall a. HasCallStack => String -> a
internalBug String
"more conventions than variables"
prettyRBind :: (Var v) => [v] -> ShowS
prettyRBind :: forall v. Var v => [v] -> ShowS
prettyRBind [] = String -> ShowS
showString String
"()"
prettyRBind [v
v] = v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v
prettyRBind (v
v : [v]
vs) =
Bool -> ShowS -> ShowS
showParen Bool
True (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> ShowS -> ShowS) -> ShowS -> [v] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\v
v ShowS
r -> v -> ShowS
forall a. Show a => a -> ShowS
shows v
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"," ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r) ShowS
forall a. a -> a
id [v]
vs
prettySuperNormal :: (Var v) => Int -> SuperNormal v -> ShowS
prettySuperNormal :: forall v. Var v => Int -> SuperNormal v -> ShowS
prettySuperNormal Int
ind (Lambda [Mem]
ccs (ABTN.TAbss [v]
vs Term ANormalF v
tm)) =
[Mem] -> [v] -> ShowS
forall v. Var v => [Mem] -> [v] -> ShowS
prettyLVars [Mem]
ccs [v]
vs
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"="
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> Term ANormalF v -> ShowS
forall v. Var v => Bool -> Int -> ANormal v -> ShowS
prettyANF Bool
False (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Term ANormalF v
tm
reqSpace :: (Var v) => Bool -> ANormal v -> Bool
reqSpace :: forall v. Var v => Bool -> ANormal v -> Bool
reqSpace Bool
_ TLets {} = Bool
True
reqSpace Bool
_ TName {} = Bool
True
reqSpace Bool
b Term ANormalF v
_ = Bool
b
prettyANF :: (Var v) => Bool -> Int -> ANormal v -> ShowS
prettyANF :: forall v. Var v => Bool -> Int -> ANormal v -> ShowS
prettyANF Bool
m Int
ind ANormal v
tm =
Bool -> Int -> ShowS
prettySpace (Bool -> ANormal v -> Bool
forall v. Var v => Bool -> ANormal v -> Bool
reqSpace Bool
m ANormal v
tm) Int
ind ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case ANormal v
tm of
TLets Direction Word16
_ [v]
vs [Mem]
_ ANormal v
bn ANormal v
bo ->
[v] -> ShowS
forall v. Var v => [v] -> ShowS
prettyRBind [v]
vs
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" ="
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> ANormal v -> ShowS
forall v. Var v => Bool -> Int -> ANormal v -> ShowS
prettyANF Bool
False (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ANormal v
bn
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> ANormal v -> ShowS
forall v. Var v => Bool -> Int -> ANormal v -> ShowS
prettyANF Bool
True Int
ind ANormal v
bo
TName v
v Either Reference v
f [v]
vs ANormal v
bo ->
[v] -> ShowS
forall v. Var v => [v] -> ShowS
prettyRBind [v
v]
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" := "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Reference v -> ShowS
forall v. Var v => Either Reference v -> ShowS
prettyLZF Either Reference v
f
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ShowS
forall v. Var v => [v] -> ShowS
prettyVars [v]
vs
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> ANormal v -> ShowS
forall v. Var v => Bool -> Int -> ANormal v -> ShowS
prettyANF Bool
True Int
ind ANormal v
bo
TLit Lit
l -> Lit -> ShowS
forall a. Show a => a -> ShowS
shows Lit
l
TFrc v
v -> String -> ShowS
showString String
"!" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v
TVar v
v -> v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v
TApp Func v
f [v]
vs -> Func v -> ShowS
forall v. Var v => Func v -> ShowS
prettyFunc Func v
f ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ShowS
forall v. Var v => [v] -> ShowS
prettyVars [v]
vs
TMatch v
v Branched (ANormal v)
bs ->
String -> ShowS
showString String
"match "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" with"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Branched (ANormal v) -> ShowS
forall v. Var v => Int -> Branched (ANormal v) -> ShowS
prettyBranches (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Branched (ANormal v)
bs
TShift Reference
r v
v ANormal v
bo ->
String -> ShowS
showString String
"shift["
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
forall a. Show a => a -> ShowS
shows Reference
r
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"]"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ShowS
forall v. Var v => [v] -> ShowS
prettyVars [v
v]
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"."
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> ANormal v -> ShowS
forall v. Var v => Bool -> Int -> ANormal v -> ShowS
prettyANF Bool
False (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ANormal v
bo
THnd [Reference]
rs v
v ANormal v
bo ->
String -> ShowS
showString String
"handle"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Reference] -> ShowS
prettyRefs [Reference]
rs
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> ANormal v -> ShowS
forall v. Var v => Bool -> Int -> ANormal v -> ShowS
prettyANF Bool
False (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ANormal v
bo
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" with "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v
ANormal v
_ -> ANormal v -> ShowS
forall a. Show a => a -> ShowS
shows ANormal v
tm
prettySpace :: Bool -> Int -> ShowS
prettySpace :: Bool -> Int -> ShowS
prettySpace Bool
False Int
_ = String -> ShowS
showString String
" "
prettySpace Bool
True Int
ind = String -> ShowS
showString String
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indent Int
ind
prettyLZF :: (Var v) => Either Reference v -> ShowS
prettyLZF :: forall v. Var v => Either Reference v -> ShowS
prettyLZF (Left Reference
w) = String -> ShowS
showString String
"ENV(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
forall a. Show a => a -> ShowS
shows Reference
w ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
") "
prettyLZF (Right v
v) = v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
prettyRefs :: [Reference] -> ShowS
prettyRefs :: [Reference] -> ShowS
prettyRefs [] = String -> ShowS
showString String
"{}"
prettyRefs (Reference
r : [Reference]
rs) =
String -> ShowS
showString String
"{"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
forall a. Show a => a -> ShowS
shows Reference
r
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> ShowS -> ShowS) -> ShowS -> [Reference] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Reference
t ShowS
r -> Reference -> ShowS
forall a. Show a => a -> ShowS
shows Reference
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"," ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r) ShowS
forall a. a -> a
id [Reference]
rs
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"}"
prettyFunc :: (Var v) => Func v -> ShowS
prettyFunc :: forall v. Var v => Func v -> ShowS
prettyFunc (FVar v
v) = v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
prettyFunc (FCont v
v) = v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
prettyFunc (FComb Reference
w) = String -> ShowS
showString String
"ENV(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
forall a. Show a => a -> ShowS
shows Reference
w ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
prettyFunc (FCon Reference
r CTag
t) =
String -> ShowS
showString String
"CON("
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
forall a. Show a => a -> ShowS
shows Reference
r
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
","
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTag -> ShowS
forall a. Show a => a -> ShowS
shows CTag
t
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
prettyFunc (FReq Reference
r CTag
t) =
String -> ShowS
showString String
"REQ("
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
forall a. Show a => a -> ShowS
shows Reference
r
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
","
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTag -> ShowS
forall a. Show a => a -> ShowS
shows CTag
t
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
prettyFunc (FPrim Either POp Word64
op) = (POp -> ShowS) -> (Word64 -> ShowS) -> Either POp Word64 -> ShowS
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either POp -> ShowS
forall a. Show a => a -> ShowS
shows Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Either POp Word64
op ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
prettyBranches :: (Var v) => Int -> Branched (ANormal v) -> ShowS
prettyBranches :: forall v. Var v => Int -> Branched (ANormal v) -> ShowS
prettyBranches Int
ind Branched (ANormal v)
bs = case Branched (ANormal v)
bs of
Branched (ANormal v)
MatchEmpty -> String -> ShowS
showString String
"{}"
MatchIntegral EnumMap Word64 (ANormal v)
bs Maybe (ANormal v)
df ->
ShowS -> (ANormal v -> ShowS) -> Maybe (ANormal v) -> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id (\ANormal v
e -> Int -> ShowS -> ANormal v -> ShowS -> ShowS
forall v. Var v => Int -> ShowS -> ANormal v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"_") ANormal v
e ShowS
forall a. a -> a
id) Maybe (ANormal v)
df
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, ANormal v) -> ShowS -> ShowS)
-> ShowS -> [(Word64, ANormal v)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Word64 -> ANormal v -> ShowS -> ShowS)
-> (Word64, ANormal v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Word64 -> ANormal v -> ShowS -> ShowS)
-> (Word64, ANormal v) -> ShowS -> ShowS)
-> (Word64 -> ANormal v -> ShowS -> ShowS)
-> (Word64, ANormal v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal v -> ShowS -> ShowS
forall v. Var v => Int -> ShowS -> ANormal v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal v -> ShowS -> ShowS)
-> (Word64 -> ShowS) -> Word64 -> ANormal v -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows) ShowS
forall a. a -> a
id (EnumMap Word64 (ANormal v) -> [(Word64, ANormal v)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList EnumMap Word64 (ANormal v)
bs)
MatchText Map Text (ANormal v)
bs Maybe (ANormal v)
df ->
ShowS -> (ANormal v -> ShowS) -> Maybe (ANormal v) -> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id (\ANormal v
e -> Int -> ShowS -> ANormal v -> ShowS -> ShowS
forall v. Var v => Int -> ShowS -> ANormal v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"_") ANormal v
e ShowS
forall a. a -> a
id) Maybe (ANormal v)
df
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, ANormal v) -> ShowS -> ShowS)
-> ShowS -> [(Text, ANormal v)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Text -> ANormal v -> ShowS -> ShowS)
-> (Text, ANormal v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Text -> ANormal v -> ShowS -> ShowS)
-> (Text, ANormal v) -> ShowS -> ShowS)
-> (Text -> ANormal v -> ShowS -> ShowS)
-> (Text, ANormal v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal v -> ShowS -> ShowS
forall v. Var v => Int -> ShowS -> ANormal v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal v -> ShowS -> ShowS)
-> (Text -> ShowS) -> Text -> ANormal v -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ShowS
forall a. Show a => a -> ShowS
shows) ShowS
forall a. a -> a
id (Map Text (ANormal v) -> [(Text, ANormal v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text (ANormal v)
bs)
MatchData Reference
_ EnumMap CTag ([Mem], ANormal v)
bs Maybe (ANormal v)
df ->
ShowS -> (ANormal v -> ShowS) -> Maybe (ANormal v) -> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id (\ANormal v
e -> Int -> ShowS -> ANormal v -> ShowS -> ShowS
forall v. Var v => Int -> ShowS -> ANormal v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"_") ANormal v
e ShowS
forall a. a -> a
id) Maybe (ANormal v)
df
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CTag, ANormal v) -> ShowS -> ShowS)
-> ShowS -> [(CTag, ANormal v)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
((CTag -> ANormal v -> ShowS -> ShowS)
-> (CTag, ANormal v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((CTag -> ANormal v -> ShowS -> ShowS)
-> (CTag, ANormal v) -> ShowS -> ShowS)
-> (CTag -> ANormal v -> ShowS -> ShowS)
-> (CTag, ANormal v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal v -> ShowS -> ShowS
forall v. Var v => Int -> ShowS -> ANormal v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal v -> ShowS -> ShowS)
-> (CTag -> ShowS) -> CTag -> ANormal v -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTag -> ShowS
forall a. Show a => a -> ShowS
shows)
ShowS
forall a. a -> a
id
(EnumMap CTag (ANormal v) -> [(CTag, ANormal v)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList (EnumMap CTag (ANormal v) -> [(CTag, ANormal v)])
-> EnumMap CTag (ANormal v) -> [(CTag, ANormal v)]
forall a b. (a -> b) -> a -> b
$ ([Mem], ANormal v) -> ANormal v
forall a b. (a, b) -> b
snd (([Mem], ANormal v) -> ANormal v)
-> EnumMap CTag ([Mem], ANormal v) -> EnumMap CTag (ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnumMap CTag ([Mem], ANormal v)
bs)
MatchRequest Map Reference (EnumMap CTag ([Mem], ANormal v))
bs ANormal v
df ->
((Reference, EnumMap CTag ([Mem], ANormal v)) -> ShowS -> ShowS)
-> ShowS -> [(Reference, EnumMap CTag ([Mem], ANormal v))] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
( \(Reference
r, EnumMap CTag ([Mem], ANormal v)
m) ShowS
s ->
((CTag, ANormal v) -> ShowS -> ShowS)
-> ShowS -> [(CTag, ANormal v)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\(CTag
c, ANormal v
e) -> Int -> ShowS -> ANormal v -> ShowS -> ShowS
forall v. Var v => Int -> ShowS -> ANormal v -> ShowS -> ShowS
prettyCase Int
ind (Reference -> CTag -> ShowS
forall {a} {a}. (Show a, Show a) => a -> a -> ShowS
prettyReq Reference
r CTag
c) ANormal v
e)
ShowS
s
(EnumMap CTag (ANormal v) -> [(CTag, ANormal v)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList (EnumMap CTag (ANormal v) -> [(CTag, ANormal v)])
-> EnumMap CTag (ANormal v) -> [(CTag, ANormal v)]
forall a b. (a -> b) -> a -> b
$ ([Mem], ANormal v) -> ANormal v
forall a b. (a, b) -> b
snd (([Mem], ANormal v) -> ANormal v)
-> EnumMap CTag ([Mem], ANormal v) -> EnumMap CTag (ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnumMap CTag ([Mem], ANormal v)
m)
)
(Int -> ShowS -> ANormal v -> ShowS -> ShowS
forall v. Var v => Int -> ShowS -> ANormal v -> ShowS -> ShowS
prettyCase Int
ind (Int -> Int -> ShowS
forall {a} {a}. (Show a, Show a) => a -> a -> ShowS
prettyReq (Int
0 :: Int) (Int
0 :: Int)) ANormal v
df ShowS
forall a. a -> a
id)
(Map Reference (EnumMap CTag ([Mem], ANormal v))
-> [(Reference, EnumMap CTag ([Mem], ANormal v))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Reference (EnumMap CTag ([Mem], ANormal v))
bs)
MatchSum EnumMap Word64 ([Mem], ANormal v)
bs ->
((Word64, ANormal v) -> ShowS -> ShowS)
-> ShowS -> [(Word64, ANormal v)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
((Word64 -> ANormal v -> ShowS -> ShowS)
-> (Word64, ANormal v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Word64 -> ANormal v -> ShowS -> ShowS)
-> (Word64, ANormal v) -> ShowS -> ShowS)
-> (Word64 -> ANormal v -> ShowS -> ShowS)
-> (Word64, ANormal v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal v -> ShowS -> ShowS
forall v. Var v => Int -> ShowS -> ANormal v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal v -> ShowS -> ShowS)
-> (Word64 -> ShowS) -> Word64 -> ANormal v -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows)
ShowS
forall a. a -> a
id
(EnumMap Word64 (ANormal v) -> [(Word64, ANormal v)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList (EnumMap Word64 (ANormal v) -> [(Word64, ANormal v)])
-> EnumMap Word64 (ANormal v) -> [(Word64, ANormal v)]
forall a b. (a -> b) -> a -> b
$ ([Mem], ANormal v) -> ANormal v
forall a b. (a, b) -> b
snd (([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v) -> EnumMap Word64 (ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnumMap Word64 ([Mem], ANormal v)
bs)
MatchNumeric Reference
_ EnumMap Word64 (ANormal v)
bs Maybe (ANormal v)
df ->
ShowS -> (ANormal v -> ShowS) -> Maybe (ANormal v) -> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id (\ANormal v
e -> Int -> ShowS -> ANormal v -> ShowS -> ShowS
forall v. Var v => Int -> ShowS -> ANormal v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"_") ANormal v
e ShowS
forall a. a -> a
id) Maybe (ANormal v)
df
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, ANormal v) -> ShowS -> ShowS)
-> ShowS -> [(Word64, ANormal v)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Word64 -> ANormal v -> ShowS -> ShowS)
-> (Word64, ANormal v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Word64 -> ANormal v -> ShowS -> ShowS)
-> (Word64, ANormal v) -> ShowS -> ShowS)
-> (Word64 -> ANormal v -> ShowS -> ShowS)
-> (Word64, ANormal v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal v -> ShowS -> ShowS
forall v. Var v => Int -> ShowS -> ANormal v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal v -> ShowS -> ShowS)
-> (Word64 -> ShowS) -> Word64 -> ANormal v -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows) ShowS
forall a. a -> a
id (EnumMap Word64 (ANormal v) -> [(Word64, ANormal v)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList EnumMap Word64 (ANormal v)
bs)
where
prettyReq :: a -> a -> ShowS
prettyReq a
r a
c =
String -> ShowS
showString String
"REQ("
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
r
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
","
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
c
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
prettyCase :: (Var v) => Int -> ShowS -> ANormal v -> ShowS -> ShowS
prettyCase :: forall v. Var v => Int -> ShowS -> ANormal v -> ShowS -> ShowS
prettyCase Int
ind ShowS
sc (ABTN.TAbss [v]
vs Term ANormalF v
e) ShowS
r =
String -> ShowS
showString String
"\n"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indent Int
ind
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
sc
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ShowS
forall v. Var v => [v] -> ShowS
prettyVars [v]
vs
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" ->"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> Term ANormalF v -> ShowS
forall v. Var v => Bool -> Int -> ANormal v -> ShowS
prettyANF Bool
False (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Term ANormalF v
e
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r