{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UnicodeSyntax #-}

module Unison.Term where

import Control.Lens (Lens', Prism', lens, _2)
import Control.Monad.State (evalState)
import Control.Monad.State qualified as State
import Control.Monad.Writer.Strict qualified as Writer
import Data.Generics.Sum (_Ctor)
import Data.List qualified as List
import Data.Map qualified as Map
import Data.Sequence qualified as Seq
import Data.Sequence qualified as Sequence
import Data.Set qualified as Set
import Data.Text qualified as Text
import Text.Show
import Unison.ABT qualified as ABT
import Unison.Blank qualified as B
import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
import Unison.ConstructorReference qualified as ConstructorReference
import Unison.ConstructorType qualified as CT
import Unison.DataDeclaration.ConstructorId (ConstructorId)
import Unison.HashQualified qualified as HQ
import Unison.LabeledDependency (LabeledDependency)
import Unison.LabeledDependency qualified as LD
import Unison.Name qualified as Name
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.Names.ResolutionResult qualified as Names
import Unison.Names.ResolvesTo (ResolvesTo (..), partitionResolutions)
import Unison.NamesWithHistory qualified as Names
import Unison.Pattern (Pattern)
import Unison.Pattern qualified as Pattern
import Unison.Prelude
import Unison.Reference (Reference, TermReference, TypeReference, pattern Builtin)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.Util.Defns (Defns (..), DefnsF)
import Unison.Util.List (multimap, validate)
import Unison.Var (Var)
import Unison.Var qualified as Var
import Unsafe.Coerce (unsafeCoerce)
import Prelude hiding (and, or)

data MatchCase loc a = MatchCase
  { forall loc a. MatchCase loc a -> Pattern loc
matchPattern :: Pattern loc,
    forall loc a. MatchCase loc a -> Maybe a
matchGuard :: Maybe a,
    forall loc a. MatchCase loc a -> a
matchBody :: a
  }
  deriving (Int -> MatchCase loc a -> ShowS
[MatchCase loc a] -> ShowS
MatchCase loc a -> String
(Int -> MatchCase loc a -> ShowS)
-> (MatchCase loc a -> String)
-> ([MatchCase loc a] -> ShowS)
-> Show (MatchCase loc a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall loc a. Show a => Int -> MatchCase loc a -> ShowS
forall loc a. Show a => [MatchCase loc a] -> ShowS
forall loc a. Show a => MatchCase loc a -> String
$cshowsPrec :: forall loc a. Show a => Int -> MatchCase loc a -> ShowS
showsPrec :: Int -> MatchCase loc a -> ShowS
$cshow :: forall loc a. Show a => MatchCase loc a -> String
show :: MatchCase loc a -> String
$cshowList :: forall loc a. Show a => [MatchCase loc a] -> ShowS
showList :: [MatchCase loc a] -> ShowS
Show, MatchCase loc a -> MatchCase loc a -> Bool
(MatchCase loc a -> MatchCase loc a -> Bool)
-> (MatchCase loc a -> MatchCase loc a -> Bool)
-> Eq (MatchCase loc a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall loc a. Eq a => MatchCase loc a -> MatchCase loc a -> Bool
$c== :: forall loc a. Eq a => MatchCase loc a -> MatchCase loc a -> Bool
== :: MatchCase loc a -> MatchCase loc a -> Bool
$c/= :: forall loc a. Eq a => MatchCase loc a -> MatchCase loc a -> Bool
/= :: MatchCase loc a -> MatchCase loc a -> Bool
Eq, Eq (MatchCase loc a)
Eq (MatchCase loc a) =>
(MatchCase loc a -> MatchCase loc a -> Ordering)
-> (MatchCase loc a -> MatchCase loc a -> Bool)
-> (MatchCase loc a -> MatchCase loc a -> Bool)
-> (MatchCase loc a -> MatchCase loc a -> Bool)
-> (MatchCase loc a -> MatchCase loc a -> Bool)
-> (MatchCase loc a -> MatchCase loc a -> MatchCase loc a)
-> (MatchCase loc a -> MatchCase loc a -> MatchCase loc a)
-> Ord (MatchCase loc a)
MatchCase loc a -> MatchCase loc a -> Bool
MatchCase loc a -> MatchCase loc a -> Ordering
MatchCase loc a -> MatchCase loc a -> MatchCase loc 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 loc a. (Ord loc, Ord a) => Eq (MatchCase loc a)
forall loc a.
(Ord loc, Ord a) =>
MatchCase loc a -> MatchCase loc a -> Bool
forall loc a.
(Ord loc, Ord a) =>
MatchCase loc a -> MatchCase loc a -> Ordering
forall loc a.
(Ord loc, Ord a) =>
MatchCase loc a -> MatchCase loc a -> MatchCase loc a
$ccompare :: forall loc a.
(Ord loc, Ord a) =>
MatchCase loc a -> MatchCase loc a -> Ordering
compare :: MatchCase loc a -> MatchCase loc a -> Ordering
$c< :: forall loc a.
(Ord loc, Ord a) =>
MatchCase loc a -> MatchCase loc a -> Bool
< :: MatchCase loc a -> MatchCase loc a -> Bool
$c<= :: forall loc a.
(Ord loc, Ord a) =>
MatchCase loc a -> MatchCase loc a -> Bool
<= :: MatchCase loc a -> MatchCase loc a -> Bool
$c> :: forall loc a.
(Ord loc, Ord a) =>
MatchCase loc a -> MatchCase loc a -> Bool
> :: MatchCase loc a -> MatchCase loc a -> Bool
$c>= :: forall loc a.
(Ord loc, Ord a) =>
MatchCase loc a -> MatchCase loc a -> Bool
>= :: MatchCase loc a -> MatchCase loc a -> Bool
$cmax :: forall loc a.
(Ord loc, Ord a) =>
MatchCase loc a -> MatchCase loc a -> MatchCase loc a
max :: MatchCase loc a -> MatchCase loc a -> MatchCase loc a
$cmin :: forall loc a.
(Ord loc, Ord a) =>
MatchCase loc a -> MatchCase loc a -> MatchCase loc a
min :: MatchCase loc a -> MatchCase loc a -> MatchCase loc a
Ord, (forall m. Monoid m => MatchCase loc m -> m)
-> (forall m a. Monoid m => (a -> m) -> MatchCase loc a -> m)
-> (forall m a. Monoid m => (a -> m) -> MatchCase loc a -> m)
-> (forall a b. (a -> b -> b) -> b -> MatchCase loc a -> b)
-> (forall a b. (a -> b -> b) -> b -> MatchCase loc a -> b)
-> (forall b a. (b -> a -> b) -> b -> MatchCase loc a -> b)
-> (forall b a. (b -> a -> b) -> b -> MatchCase loc a -> b)
-> (forall a. (a -> a -> a) -> MatchCase loc a -> a)
-> (forall a. (a -> a -> a) -> MatchCase loc a -> a)
-> (forall a. MatchCase loc a -> [a])
-> (forall a. MatchCase loc a -> Bool)
-> (forall a. MatchCase loc a -> Int)
-> (forall a. Eq a => a -> MatchCase loc a -> Bool)
-> (forall a. Ord a => MatchCase loc a -> a)
-> (forall a. Ord a => MatchCase loc a -> a)
-> (forall a. Num a => MatchCase loc a -> a)
-> (forall a. Num a => MatchCase loc a -> a)
-> Foldable (MatchCase loc)
forall a. Eq a => a -> MatchCase loc a -> Bool
forall a. Num a => MatchCase loc a -> a
forall a. Ord a => MatchCase loc a -> a
forall m. Monoid m => MatchCase loc m -> m
forall a. MatchCase loc a -> Bool
forall a. MatchCase loc a -> Int
forall a. MatchCase loc a -> [a]
forall a. (a -> a -> a) -> MatchCase loc a -> a
forall loc a. Eq a => a -> MatchCase loc a -> Bool
forall loc a. Num a => MatchCase loc a -> a
forall loc a. Ord a => MatchCase loc a -> a
forall m a. Monoid m => (a -> m) -> MatchCase loc a -> m
forall loc m. Monoid m => MatchCase loc m -> m
forall loc a. MatchCase loc a -> Bool
forall loc a. MatchCase loc a -> Int
forall loc a. MatchCase loc a -> [a]
forall b a. (b -> a -> b) -> b -> MatchCase loc a -> b
forall a b. (a -> b -> b) -> b -> MatchCase loc a -> b
forall loc a. (a -> a -> a) -> MatchCase loc a -> a
forall loc m a. Monoid m => (a -> m) -> MatchCase loc a -> m
forall loc b a. (b -> a -> b) -> b -> MatchCase loc a -> b
forall loc a b. (a -> b -> b) -> b -> MatchCase loc 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 loc m. Monoid m => MatchCase loc m -> m
fold :: forall m. Monoid m => MatchCase loc m -> m
$cfoldMap :: forall loc m a. Monoid m => (a -> m) -> MatchCase loc a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> MatchCase loc a -> m
$cfoldMap' :: forall loc m a. Monoid m => (a -> m) -> MatchCase loc a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> MatchCase loc a -> m
$cfoldr :: forall loc a b. (a -> b -> b) -> b -> MatchCase loc a -> b
foldr :: forall a b. (a -> b -> b) -> b -> MatchCase loc a -> b
$cfoldr' :: forall loc a b. (a -> b -> b) -> b -> MatchCase loc a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MatchCase loc a -> b
$cfoldl :: forall loc b a. (b -> a -> b) -> b -> MatchCase loc a -> b
foldl :: forall b a. (b -> a -> b) -> b -> MatchCase loc a -> b
$cfoldl' :: forall loc b a. (b -> a -> b) -> b -> MatchCase loc a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> MatchCase loc a -> b
$cfoldr1 :: forall loc a. (a -> a -> a) -> MatchCase loc a -> a
foldr1 :: forall a. (a -> a -> a) -> MatchCase loc a -> a
$cfoldl1 :: forall loc a. (a -> a -> a) -> MatchCase loc a -> a
foldl1 :: forall a. (a -> a -> a) -> MatchCase loc a -> a
$ctoList :: forall loc a. MatchCase loc a -> [a]
toList :: forall a. MatchCase loc a -> [a]
$cnull :: forall loc a. MatchCase loc a -> Bool
null :: forall a. MatchCase loc a -> Bool
$clength :: forall loc a. MatchCase loc a -> Int
length :: forall a. MatchCase loc a -> Int
$celem :: forall loc a. Eq a => a -> MatchCase loc a -> Bool
elem :: forall a. Eq a => a -> MatchCase loc a -> Bool
$cmaximum :: forall loc a. Ord a => MatchCase loc a -> a
maximum :: forall a. Ord a => MatchCase loc a -> a
$cminimum :: forall loc a. Ord a => MatchCase loc a -> a
minimum :: forall a. Ord a => MatchCase loc a -> a
$csum :: forall loc a. Num a => MatchCase loc a -> a
sum :: forall a. Num a => MatchCase loc a -> a
$cproduct :: forall loc a. Num a => MatchCase loc a -> a
product :: forall a. Num a => MatchCase loc a -> a
Foldable, (forall a b. (a -> b) -> MatchCase loc a -> MatchCase loc b)
-> (forall a b. a -> MatchCase loc b -> MatchCase loc a)
-> Functor (MatchCase loc)
forall a b. a -> MatchCase loc b -> MatchCase loc a
forall a b. (a -> b) -> MatchCase loc a -> MatchCase loc b
forall loc a b. a -> MatchCase loc b -> MatchCase loc a
forall loc a b. (a -> b) -> MatchCase loc a -> MatchCase loc b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall loc a b. (a -> b) -> MatchCase loc a -> MatchCase loc b
fmap :: forall a b. (a -> b) -> MatchCase loc a -> MatchCase loc b
$c<$ :: forall loc a b. a -> MatchCase loc b -> MatchCase loc a
<$ :: forall a b. a -> MatchCase loc b -> MatchCase loc a
Functor, (forall x. MatchCase loc a -> Rep (MatchCase loc a) x)
-> (forall x. Rep (MatchCase loc a) x -> MatchCase loc a)
-> Generic (MatchCase loc a)
forall x. Rep (MatchCase loc a) x -> MatchCase loc a
forall x. MatchCase loc a -> Rep (MatchCase loc a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall loc a x. Rep (MatchCase loc a) x -> MatchCase loc a
forall loc a x. MatchCase loc a -> Rep (MatchCase loc a) x
$cfrom :: forall loc a x. MatchCase loc a -> Rep (MatchCase loc a) x
from :: forall x. MatchCase loc a -> Rep (MatchCase loc a) x
$cto :: forall loc a x. Rep (MatchCase loc a) x -> MatchCase loc a
to :: forall x. Rep (MatchCase loc a) x -> MatchCase loc a
Generic, (forall a. MatchCase loc a -> Rep1 (MatchCase loc) a)
-> (forall a. Rep1 (MatchCase loc) a -> MatchCase loc a)
-> Generic1 (MatchCase loc)
forall a. Rep1 (MatchCase loc) a -> MatchCase loc a
forall a. MatchCase loc a -> Rep1 (MatchCase loc) a
forall loc a. Rep1 (MatchCase loc) a -> MatchCase loc a
forall loc a. MatchCase loc a -> Rep1 (MatchCase loc) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall loc a. MatchCase loc a -> Rep1 (MatchCase loc) a
from1 :: forall a. MatchCase loc a -> Rep1 (MatchCase loc) a
$cto1 :: forall loc a. Rep1 (MatchCase loc) a -> MatchCase loc a
to1 :: forall a. Rep1 (MatchCase loc) a -> MatchCase loc a
Generic1, Functor (MatchCase loc)
Foldable (MatchCase loc)
(Functor (MatchCase loc), Foldable (MatchCase loc)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> MatchCase loc a -> f (MatchCase loc b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    MatchCase loc (f a) -> f (MatchCase loc a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MatchCase loc a -> m (MatchCase loc b))
-> (forall (m :: * -> *) a.
    Monad m =>
    MatchCase loc (m a) -> m (MatchCase loc a))
-> Traversable (MatchCase loc)
forall loc. Functor (MatchCase loc)
forall loc. Foldable (MatchCase loc)
forall loc (m :: * -> *) a.
Monad m =>
MatchCase loc (m a) -> m (MatchCase loc a)
forall loc (f :: * -> *) a.
Applicative f =>
MatchCase loc (f a) -> f (MatchCase loc a)
forall loc (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MatchCase loc a -> m (MatchCase loc b)
forall loc (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MatchCase loc a -> f (MatchCase loc b)
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 =>
MatchCase loc (m a) -> m (MatchCase loc a)
forall (f :: * -> *) a.
Applicative f =>
MatchCase loc (f a) -> f (MatchCase loc a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MatchCase loc a -> m (MatchCase loc b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MatchCase loc a -> f (MatchCase loc b)
$ctraverse :: forall loc (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MatchCase loc a -> f (MatchCase loc b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MatchCase loc a -> f (MatchCase loc b)
$csequenceA :: forall loc (f :: * -> *) a.
Applicative f =>
MatchCase loc (f a) -> f (MatchCase loc a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
MatchCase loc (f a) -> f (MatchCase loc a)
$cmapM :: forall loc (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MatchCase loc a -> m (MatchCase loc b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MatchCase loc a -> m (MatchCase loc b)
$csequence :: forall loc (m :: * -> *) a.
Monad m =>
MatchCase loc (m a) -> m (MatchCase loc a)
sequence :: forall (m :: * -> *) a.
Monad m =>
MatchCase loc (m a) -> m (MatchCase loc a)
Traversable)

matchPattern_ :: Lens' (MatchCase loc a) (Pattern loc)
matchPattern_ :: forall loc a (f :: * -> *).
Functor f =>
(Pattern loc -> f (Pattern loc))
-> MatchCase loc a -> f (MatchCase loc a)
matchPattern_ = (MatchCase loc a -> Pattern loc)
-> (MatchCase loc a -> Pattern loc -> MatchCase loc a)
-> Lens
     (MatchCase loc a) (MatchCase loc a) (Pattern loc) (Pattern loc)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens MatchCase loc a -> Pattern loc
forall loc a. MatchCase loc a -> Pattern loc
matchPattern MatchCase loc a -> Pattern loc -> MatchCase loc a
forall {loc} {a} {loc}.
MatchCase loc a -> Pattern loc -> MatchCase loc a
setter
  where
    setter :: MatchCase loc a -> Pattern loc -> MatchCase loc a
setter MatchCase loc a
m Pattern loc
p = MatchCase loc a
m {matchPattern = p}

-- | Base functor for terms in the Unison language
-- We need `typeVar` because the term and type variables may differ.
data F typeVar typeAnn patternAnn a
  = Int Int64
  | Nat Word64
  | Float Double
  | Boolean Bool
  | Text Text
  | Char Char
  | Blank (B.Blank typeAnn)
  | Ref Reference
  | Constructor ConstructorReference
  | Request ConstructorReference
  | Handle a a
  | App a a
  | Ann a (Type typeVar typeAnn)
  | List (Seq a)
  | If a a a
  | And a a
  | Or a a
  | Lam a
  | -- Note: let rec blocks have an outer ABT.Cycle which introduces as many
    -- variables as there are bindings
    LetRec IsTop [a] a
  | -- Note: first parameter is the binding, second is the expression which may refer
    -- to this let bound variable. Constructed as `Let b (abs v e)`
    Let IsTop a a
  | -- Pattern matching / eliminating data types, example:
    --  case x of
    --    Just n -> rhs1
    --    Nothing -> rhs2
    --
    -- translates to
    --
    --   Match x
    --     [ (Constructor 0 [Var], ABT.abs n rhs1)
    --     , (Constructor 1 [], rhs2) ]
    Match a [MatchCase patternAnn a]
  | TermLink Referent
  | TypeLink Reference
  deriving (Eq (F typeVar typeAnn patternAnn a)
Eq (F typeVar typeAnn patternAnn a) =>
(F typeVar typeAnn patternAnn a
 -> F typeVar typeAnn patternAnn a -> Ordering)
-> (F typeVar typeAnn patternAnn a
    -> F typeVar typeAnn patternAnn a -> Bool)
-> (F typeVar typeAnn patternAnn a
    -> F typeVar typeAnn patternAnn a -> Bool)
-> (F typeVar typeAnn patternAnn a
    -> F typeVar typeAnn patternAnn a -> Bool)
-> (F typeVar typeAnn patternAnn a
    -> F typeVar typeAnn patternAnn a -> Bool)
-> (F typeVar typeAnn patternAnn a
    -> F typeVar typeAnn patternAnn a
    -> F typeVar typeAnn patternAnn a)
-> (F typeVar typeAnn patternAnn a
    -> F typeVar typeAnn patternAnn a
    -> F typeVar typeAnn patternAnn a)
-> Ord (F typeVar typeAnn patternAnn a)
F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> Bool
F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> Ordering
F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> F typeVar typeAnn patternAnn 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 typeVar typeAnn patternAnn a.
(Var typeVar, Ord typeAnn, Ord a, Ord patternAnn) =>
Eq (F typeVar typeAnn patternAnn a)
forall typeVar typeAnn patternAnn a.
(Var typeVar, Ord typeAnn, Ord a, Ord patternAnn) =>
F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> Bool
forall typeVar typeAnn patternAnn a.
(Var typeVar, Ord typeAnn, Ord a, Ord patternAnn) =>
F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> Ordering
forall typeVar typeAnn patternAnn a.
(Var typeVar, Ord typeAnn, Ord a, Ord patternAnn) =>
F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> F typeVar typeAnn patternAnn a
$ccompare :: forall typeVar typeAnn patternAnn a.
(Var typeVar, Ord typeAnn, Ord a, Ord patternAnn) =>
F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> Ordering
compare :: F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> Ordering
$c< :: forall typeVar typeAnn patternAnn a.
(Var typeVar, Ord typeAnn, Ord a, Ord patternAnn) =>
F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> Bool
< :: F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> Bool
$c<= :: forall typeVar typeAnn patternAnn a.
(Var typeVar, Ord typeAnn, Ord a, Ord patternAnn) =>
F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> Bool
<= :: F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> Bool
$c> :: forall typeVar typeAnn patternAnn a.
(Var typeVar, Ord typeAnn, Ord a, Ord patternAnn) =>
F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> Bool
> :: F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> Bool
$c>= :: forall typeVar typeAnn patternAnn a.
(Var typeVar, Ord typeAnn, Ord a, Ord patternAnn) =>
F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> Bool
>= :: F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> Bool
$cmax :: forall typeVar typeAnn patternAnn a.
(Var typeVar, Ord typeAnn, Ord a, Ord patternAnn) =>
F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> F typeVar typeAnn patternAnn a
max :: F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> F typeVar typeAnn patternAnn a
$cmin :: forall typeVar typeAnn patternAnn a.
(Var typeVar, Ord typeAnn, Ord a, Ord patternAnn) =>
F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> F typeVar typeAnn patternAnn a
min :: F typeVar typeAnn patternAnn a
-> F typeVar typeAnn patternAnn a -> F typeVar typeAnn patternAnn a
Ord, (forall m. Monoid m => F typeVar typeAnn patternAnn m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> F typeVar typeAnn patternAnn a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> F typeVar typeAnn patternAnn a -> m)
-> (forall a b.
    (a -> b -> b) -> b -> F typeVar typeAnn patternAnn a -> b)
-> (forall a b.
    (a -> b -> b) -> b -> F typeVar typeAnn patternAnn a -> b)
-> (forall b a.
    (b -> a -> b) -> b -> F typeVar typeAnn patternAnn a -> b)
-> (forall b a.
    (b -> a -> b) -> b -> F typeVar typeAnn patternAnn a -> b)
-> (forall a. (a -> a -> a) -> F typeVar typeAnn patternAnn a -> a)
-> (forall a. (a -> a -> a) -> F typeVar typeAnn patternAnn a -> a)
-> (forall a. F typeVar typeAnn patternAnn a -> [a])
-> (forall a. F typeVar typeAnn patternAnn a -> Bool)
-> (forall a. F typeVar typeAnn patternAnn a -> Int)
-> (forall a. Eq a => a -> F typeVar typeAnn patternAnn a -> Bool)
-> (forall a. Ord a => F typeVar typeAnn patternAnn a -> a)
-> (forall a. Ord a => F typeVar typeAnn patternAnn a -> a)
-> (forall a. Num a => F typeVar typeAnn patternAnn a -> a)
-> (forall a. Num a => F typeVar typeAnn patternAnn a -> a)
-> Foldable (F typeVar typeAnn patternAnn)
forall a. Eq a => a -> F typeVar typeAnn patternAnn a -> Bool
forall a. Num a => F typeVar typeAnn patternAnn a -> a
forall a. Ord a => F typeVar typeAnn patternAnn a -> a
forall m. Monoid m => F typeVar typeAnn patternAnn m -> m
forall a. F typeVar typeAnn patternAnn a -> Bool
forall a. F typeVar typeAnn patternAnn a -> Int
forall a. F typeVar typeAnn patternAnn a -> [a]
forall a. (a -> a -> a) -> F typeVar typeAnn patternAnn a -> a
forall m a.
Monoid m =>
(a -> m) -> F typeVar typeAnn patternAnn a -> m
forall b a.
(b -> a -> b) -> b -> F typeVar typeAnn patternAnn a -> b
forall a b.
(a -> b -> b) -> b -> F typeVar typeAnn patternAnn a -> b
forall typeVar typeAnn patternAnn a.
Eq a =>
a -> F typeVar typeAnn patternAnn a -> Bool
forall typeVar typeAnn patternAnn a.
Num a =>
F typeVar typeAnn patternAnn a -> a
forall typeVar typeAnn patternAnn a.
Ord a =>
F typeVar typeAnn patternAnn a -> a
forall typeVar typeAnn patternAnn m.
Monoid m =>
F typeVar typeAnn patternAnn m -> m
forall typeVar typeAnn patternAnn a.
F typeVar typeAnn patternAnn a -> Bool
forall typeVar typeAnn patternAnn a.
F typeVar typeAnn patternAnn a -> Int
forall typeVar typeAnn patternAnn a.
F typeVar typeAnn patternAnn a -> [a]
forall typeVar typeAnn patternAnn a.
(a -> a -> a) -> F typeVar typeAnn patternAnn a -> a
forall typeVar typeAnn patternAnn m a.
Monoid m =>
(a -> m) -> F typeVar typeAnn patternAnn a -> m
forall typeVar typeAnn patternAnn b a.
(b -> a -> b) -> b -> F typeVar typeAnn patternAnn a -> b
forall typeVar typeAnn patternAnn a b.
(a -> b -> b) -> b -> F typeVar typeAnn patternAnn 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 typeVar typeAnn patternAnn m.
Monoid m =>
F typeVar typeAnn patternAnn m -> m
fold :: forall m. Monoid m => F typeVar typeAnn patternAnn m -> m
$cfoldMap :: forall typeVar typeAnn patternAnn m a.
Monoid m =>
(a -> m) -> F typeVar typeAnn patternAnn a -> m
foldMap :: forall m a.
Monoid m =>
(a -> m) -> F typeVar typeAnn patternAnn a -> m
$cfoldMap' :: forall typeVar typeAnn patternAnn m a.
Monoid m =>
(a -> m) -> F typeVar typeAnn patternAnn a -> m
foldMap' :: forall m a.
Monoid m =>
(a -> m) -> F typeVar typeAnn patternAnn a -> m
$cfoldr :: forall typeVar typeAnn patternAnn a b.
(a -> b -> b) -> b -> F typeVar typeAnn patternAnn a -> b
foldr :: forall a b.
(a -> b -> b) -> b -> F typeVar typeAnn patternAnn a -> b
$cfoldr' :: forall typeVar typeAnn patternAnn a b.
(a -> b -> b) -> b -> F typeVar typeAnn patternAnn a -> b
foldr' :: forall a b.
(a -> b -> b) -> b -> F typeVar typeAnn patternAnn a -> b
$cfoldl :: forall typeVar typeAnn patternAnn b a.
(b -> a -> b) -> b -> F typeVar typeAnn patternAnn a -> b
foldl :: forall b a.
(b -> a -> b) -> b -> F typeVar typeAnn patternAnn a -> b
$cfoldl' :: forall typeVar typeAnn patternAnn b a.
(b -> a -> b) -> b -> F typeVar typeAnn patternAnn a -> b
foldl' :: forall b a.
(b -> a -> b) -> b -> F typeVar typeAnn patternAnn a -> b
$cfoldr1 :: forall typeVar typeAnn patternAnn a.
(a -> a -> a) -> F typeVar typeAnn patternAnn a -> a
foldr1 :: forall a. (a -> a -> a) -> F typeVar typeAnn patternAnn a -> a
$cfoldl1 :: forall typeVar typeAnn patternAnn a.
(a -> a -> a) -> F typeVar typeAnn patternAnn a -> a
foldl1 :: forall a. (a -> a -> a) -> F typeVar typeAnn patternAnn a -> a
$ctoList :: forall typeVar typeAnn patternAnn a.
F typeVar typeAnn patternAnn a -> [a]
toList :: forall a. F typeVar typeAnn patternAnn a -> [a]
$cnull :: forall typeVar typeAnn patternAnn a.
F typeVar typeAnn patternAnn a -> Bool
null :: forall a. F typeVar typeAnn patternAnn a -> Bool
$clength :: forall typeVar typeAnn patternAnn a.
F typeVar typeAnn patternAnn a -> Int
length :: forall a. F typeVar typeAnn patternAnn a -> Int
$celem :: forall typeVar typeAnn patternAnn a.
Eq a =>
a -> F typeVar typeAnn patternAnn a -> Bool
elem :: forall a. Eq a => a -> F typeVar typeAnn patternAnn a -> Bool
$cmaximum :: forall typeVar typeAnn patternAnn a.
Ord a =>
F typeVar typeAnn patternAnn a -> a
maximum :: forall a. Ord a => F typeVar typeAnn patternAnn a -> a
$cminimum :: forall typeVar typeAnn patternAnn a.
Ord a =>
F typeVar typeAnn patternAnn a -> a
minimum :: forall a. Ord a => F typeVar typeAnn patternAnn a -> a
$csum :: forall typeVar typeAnn patternAnn a.
Num a =>
F typeVar typeAnn patternAnn a -> a
sum :: forall a. Num a => F typeVar typeAnn patternAnn a -> a
$cproduct :: forall typeVar typeAnn patternAnn a.
Num a =>
F typeVar typeAnn patternAnn a -> a
product :: forall a. Num a => F typeVar typeAnn patternAnn a -> a
Foldable, (forall a b.
 (a -> b)
 -> F typeVar typeAnn patternAnn a
 -> F typeVar typeAnn patternAnn b)
-> (forall a b.
    a
    -> F typeVar typeAnn patternAnn b
    -> F typeVar typeAnn patternAnn a)
-> Functor (F typeVar typeAnn patternAnn)
forall a b.
a
-> F typeVar typeAnn patternAnn b -> F typeVar typeAnn patternAnn a
forall a b.
(a -> b)
-> F typeVar typeAnn patternAnn a -> F typeVar typeAnn patternAnn b
forall typeVar typeAnn patternAnn a b.
a
-> F typeVar typeAnn patternAnn b -> F typeVar typeAnn patternAnn a
forall typeVar typeAnn patternAnn a b.
(a -> b)
-> F typeVar typeAnn patternAnn a -> F typeVar typeAnn patternAnn b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall typeVar typeAnn patternAnn a b.
(a -> b)
-> F typeVar typeAnn patternAnn a -> F typeVar typeAnn patternAnn b
fmap :: forall a b.
(a -> b)
-> F typeVar typeAnn patternAnn a -> F typeVar typeAnn patternAnn b
$c<$ :: forall typeVar typeAnn patternAnn a b.
a
-> F typeVar typeAnn patternAnn b -> F typeVar typeAnn patternAnn a
<$ :: forall a b.
a
-> F typeVar typeAnn patternAnn b -> F typeVar typeAnn patternAnn a
Functor, (forall x.
 F typeVar typeAnn patternAnn a
 -> Rep (F typeVar typeAnn patternAnn a) x)
-> (forall x.
    Rep (F typeVar typeAnn patternAnn a) x
    -> F typeVar typeAnn patternAnn a)
-> Generic (F typeVar typeAnn patternAnn a)
forall x.
Rep (F typeVar typeAnn patternAnn a) x
-> F typeVar typeAnn patternAnn a
forall x.
F typeVar typeAnn patternAnn a
-> Rep (F typeVar typeAnn patternAnn a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall typeVar typeAnn patternAnn a x.
Rep (F typeVar typeAnn patternAnn a) x
-> F typeVar typeAnn patternAnn a
forall typeVar typeAnn patternAnn a x.
F typeVar typeAnn patternAnn a
-> Rep (F typeVar typeAnn patternAnn a) x
$cfrom :: forall typeVar typeAnn patternAnn a x.
F typeVar typeAnn patternAnn a
-> Rep (F typeVar typeAnn patternAnn a) x
from :: forall x.
F typeVar typeAnn patternAnn a
-> Rep (F typeVar typeAnn patternAnn a) x
$cto :: forall typeVar typeAnn patternAnn a x.
Rep (F typeVar typeAnn patternAnn a) x
-> F typeVar typeAnn patternAnn a
to :: forall x.
Rep (F typeVar typeAnn patternAnn a) x
-> F typeVar typeAnn patternAnn a
Generic, (forall a.
 F typeVar typeAnn patternAnn a
 -> Rep1 (F typeVar typeAnn patternAnn) a)
-> (forall a.
    Rep1 (F typeVar typeAnn patternAnn) a
    -> F typeVar typeAnn patternAnn a)
-> Generic1 (F typeVar typeAnn patternAnn)
forall a.
Rep1 (F typeVar typeAnn patternAnn) a
-> F typeVar typeAnn patternAnn a
forall a.
F typeVar typeAnn patternAnn a
-> Rep1 (F typeVar typeAnn patternAnn) a
forall typeVar typeAnn patternAnn a.
Rep1 (F typeVar typeAnn patternAnn) a
-> F typeVar typeAnn patternAnn a
forall typeVar typeAnn patternAnn a.
F typeVar typeAnn patternAnn a
-> Rep1 (F typeVar typeAnn patternAnn) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall typeVar typeAnn patternAnn a.
F typeVar typeAnn patternAnn a
-> Rep1 (F typeVar typeAnn patternAnn) a
from1 :: forall a.
F typeVar typeAnn patternAnn a
-> Rep1 (F typeVar typeAnn patternAnn) a
$cto1 :: forall typeVar typeAnn patternAnn a.
Rep1 (F typeVar typeAnn patternAnn) a
-> F typeVar typeAnn patternAnn a
to1 :: forall a.
Rep1 (F typeVar typeAnn patternAnn) a
-> F typeVar typeAnn patternAnn a
Generic1, Functor (F typeVar typeAnn patternAnn)
Foldable (F typeVar typeAnn patternAnn)
(Functor (F typeVar typeAnn patternAnn),
 Foldable (F typeVar typeAnn patternAnn)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b)
 -> F typeVar typeAnn patternAnn a
 -> f (F typeVar typeAnn patternAnn b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    F typeVar typeAnn patternAnn (f a)
    -> f (F typeVar typeAnn patternAnn a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b)
    -> F typeVar typeAnn patternAnn a
    -> m (F typeVar typeAnn patternAnn b))
-> (forall (m :: * -> *) a.
    Monad m =>
    F typeVar typeAnn patternAnn (m a)
    -> m (F typeVar typeAnn patternAnn a))
-> Traversable (F typeVar typeAnn patternAnn)
forall typeVar typeAnn patternAnn.
Functor (F typeVar typeAnn patternAnn)
forall typeVar typeAnn patternAnn.
Foldable (F typeVar typeAnn patternAnn)
forall typeVar typeAnn patternAnn (m :: * -> *) a.
Monad m =>
F typeVar typeAnn patternAnn (m a)
-> m (F typeVar typeAnn patternAnn a)
forall typeVar typeAnn patternAnn (f :: * -> *) a.
Applicative f =>
F typeVar typeAnn patternAnn (f a)
-> f (F typeVar typeAnn patternAnn a)
forall typeVar typeAnn patternAnn (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> F typeVar typeAnn patternAnn a
-> m (F typeVar typeAnn patternAnn b)
forall typeVar typeAnn patternAnn (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> F typeVar typeAnn patternAnn a
-> f (F typeVar typeAnn patternAnn b)
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 =>
F typeVar typeAnn patternAnn (m a)
-> m (F typeVar typeAnn patternAnn a)
forall (f :: * -> *) a.
Applicative f =>
F typeVar typeAnn patternAnn (f a)
-> f (F typeVar typeAnn patternAnn a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> F typeVar typeAnn patternAnn a
-> m (F typeVar typeAnn patternAnn b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> F typeVar typeAnn patternAnn a
-> f (F typeVar typeAnn patternAnn b)
$ctraverse :: forall typeVar typeAnn patternAnn (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> F typeVar typeAnn patternAnn a
-> f (F typeVar typeAnn patternAnn b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> F typeVar typeAnn patternAnn a
-> f (F typeVar typeAnn patternAnn b)
$csequenceA :: forall typeVar typeAnn patternAnn (f :: * -> *) a.
Applicative f =>
F typeVar typeAnn patternAnn (f a)
-> f (F typeVar typeAnn patternAnn a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
F typeVar typeAnn patternAnn (f a)
-> f (F typeVar typeAnn patternAnn a)
$cmapM :: forall typeVar typeAnn patternAnn (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> F typeVar typeAnn patternAnn a
-> m (F typeVar typeAnn patternAnn b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> F typeVar typeAnn patternAnn a
-> m (F typeVar typeAnn patternAnn b)
$csequence :: forall typeVar typeAnn patternAnn (m :: * -> *) a.
Monad m =>
F typeVar typeAnn patternAnn (m a)
-> m (F typeVar typeAnn patternAnn a)
sequence :: forall (m :: * -> *) a.
Monad m =>
F typeVar typeAnn patternAnn (m a)
-> m (F typeVar typeAnn patternAnn a)
Traversable)

_Ref :: Prism' (F tv ta pa a) Reference
_Ref :: forall tv ta pa a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p Reference (f Reference) -> p (F tv ta pa a) (f (F tv ta pa a))
_Ref = forall (ctor :: Symbol) s t a b.
AsConstructor ctor s t a b =>
Prism s t a b
_Ctor @"Ref"

_Match :: Prism' (F tv ta pa a) (a, [MatchCase pa a])
_Match :: forall tv ta pa a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (a, [MatchCase pa a]) (f (a, [MatchCase pa a]))
-> p (F tv ta pa a) (f (F tv ta pa a))
_Match = forall (ctor :: Symbol) s t a b.
AsConstructor ctor s t a b =>
Prism s t a b
_Ctor @"Match"

_Constructor :: Prism' (F tv ta pa a) ConstructorReference
_Constructor :: forall tv ta pa a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p ConstructorReference (f ConstructorReference)
-> p (F tv ta pa a) (f (F tv ta pa a))
_Constructor = forall (ctor :: Symbol) s t a b.
AsConstructor ctor s t a b =>
Prism s t a b
_Ctor @"Constructor"

_Request :: Prism' (F tv ta pa a) ConstructorReference
_Request :: forall tv ta pa a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p ConstructorReference (f ConstructorReference)
-> p (F tv ta pa a) (f (F tv ta pa a))
_Request = forall (ctor :: Symbol) s t a b.
AsConstructor ctor s t a b =>
Prism s t a b
_Ctor @"Request"

_Ann :: Prism' (F tv ta pa a) (a, ABT.Term Type.F tv ta)
_Ann :: forall tv ta pa a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (a, Term F tv ta) (f (a, Term F tv ta))
-> p (F tv ta pa a) (f (F tv ta pa a))
_Ann = forall (ctor :: Symbol) s t a b.
AsConstructor ctor s t a b =>
Prism s t a b
_Ctor @"Ann"

_TermLink :: Prism' (F tv ta pa a) Referent
_TermLink :: forall tv ta pa a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p Referent (f Referent) -> p (F tv ta pa a) (f (F tv ta pa a))
_TermLink = forall (ctor :: Symbol) s t a b.
AsConstructor ctor s t a b =>
Prism s t a b
_Ctor @"TermLink"

_TypeLink :: Prism' (F tv ta pa a) Reference
_TypeLink :: forall tv ta pa a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p Reference (f Reference) -> p (F tv ta pa a) (f (F tv ta pa a))
_TypeLink = forall (ctor :: Symbol) s t a b.
AsConstructor ctor s t a b =>
Prism s t a b
_Ctor @"TypeLink"

-- | Returns the top-level type annotation for a term if it has one.
getTypeAnnotation :: Term v a -> Maybe (Type v a)
getTypeAnnotation :: forall v a. Term v a -> Maybe (Type v a)
getTypeAnnotation (ABT.Tm' (Ann Term (F v a a) v a
_ Type v a
t)) = Type v a -> Maybe (Type v a)
forall a. a -> Maybe a
Just Type v a
t
getTypeAnnotation Term (F v a a) v a
_ = Maybe (Type v a)
forall a. Maybe a
Nothing

type IsTop = Bool

-- | Like `Term v`, but with an annotation of type `a` at every level in the tree
type Term v a = Term2 v a a v a

-- | Allow type variables and term variables to differ
type Term' vt v a = Term2 vt a a v a

-- | Allow type variables, term variables, type annotations and term annotations
-- to all differ
type Term2 vt at ap v a = ABT.Term (F vt at ap) v a

-- | Like `Term v a`, but with only () for type and pattern annotations.
type Term3 v a = Term2 v () () v a

-- | Terms are represented as ABTs over the base functor F, with variables in `v`
type Term0 v = Term v ()

-- | Terms with type variables in `vt`, and term variables in `v`
type Term0' vt v = Term' vt v ()

bindNames ::
  forall v a.
  (Var v) =>
  (v -> Name.Name) ->
  (Name.Name -> v) ->
  Set v ->
  Names ->
  Term v a ->
  Names.ResolutionResult a (Term v a)
bindNames :: forall v a.
Var v =>
(v -> Name)
-> (Name -> v)
-> Set v
-> Names
-> Term v a
-> ResolutionResult a (Term v a)
bindNames v -> Name
unsafeVarToName Name -> v
nameToVar Set v
localVars Names
namespace =
  -- term is bound here because the where-clause binds a data structure that we only want to compute once, then share
  -- across all calls to `bindNames` with different terms
  \Term v a
term -> do
    let freeTmVars :: [(v, a)]
freeTmVars = Set v -> Term v a -> [(v, a)]
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
Set v -> Term f v a -> [(v, a)]
ABT.freeVarOccurrences Set v
localVars Term v a
term
        freeTyVars :: [(v, a)]
freeTyVars =
          [ (v
v, a
a) | (v
v, [a]
as) <- Map v [a] -> [(v, [a])]
forall k a. Map k a -> [(k, a)]
Map.toList (Term v a -> Map v [a]
forall vt v a. Ord vt => Term' vt v a -> Map vt [a]
freeTypeVarAnnotations Term v a
term), a
a <- [a]
as
          ]

        okTm :: (v, a) -> Maybe (v, ResolvesTo Referent)
        okTm :: (v, a) -> Maybe (v, ResolvesTo Referent)
okTm (v
v, a
_) =
          case Set (ResolvesTo Referent) -> Int
forall a. Set a -> Int
Set.size Set (ResolvesTo Referent)
matches of
            Int
1 -> (v, ResolvesTo Referent) -> Maybe (v, ResolvesTo Referent)
forall a. a -> Maybe a
Just (v
v, Set (ResolvesTo Referent) -> ResolvesTo Referent
forall a. Set a -> a
Set.findMin Set (ResolvesTo Referent)
matches)
            Int
0 -> Maybe (v, ResolvesTo Referent)
forall a. Maybe a
Nothing -- not found: leave free for telling user about expected type
            Int
_ -> Maybe (v, ResolvesTo Referent)
forall a. Maybe a
Nothing -- ambiguous: leave free for TDNR
          where
            matches :: Set (ResolvesTo Referent)
            matches :: Set (ResolvesTo Referent)
matches =
              Name -> Set (ResolvesTo Referent)
resolveTermName (v -> Name
unsafeVarToName v
v)

        okTy :: (v, a) -> Names.ResolutionResult a (v, Type v a)
        okTy :: (v, a) -> ResolutionResult a (v, Type v a)
okTy (v
v, a
a) =
          case SearchType -> HashQualified Name -> Names -> Set Reference
Names.lookupHQType SearchType
Names.IncludeSuffixes HashQualified Name
hqName Names
namespace of
            Set Reference
rs
              | Set Reference -> Int
forall a. Set a -> Int
Set.size Set Reference
rs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> (v, Type v a) -> ResolutionResult a (v, Type v a)
forall a. a -> Either (Seq (ResolutionFailure a)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v
v, a -> Reference -> Type v a
forall v a. Ord v => a -> Reference -> Type v a
Type.ref a
a (Reference -> Type v a) -> Reference -> Type v a
forall a b. (a -> b) -> a -> b
$ Set Reference -> Reference
forall a. Set a -> a
Set.findMin Set Reference
rs)
              | Set Reference -> Int
forall a. Set a -> Int
Set.size Set Reference
rs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Seq (ResolutionFailure a) -> ResolutionResult a (v, Type v a)
forall a b. a -> Either a b
Left (ResolutionFailure a -> Seq (ResolutionFailure a)
forall a. a -> Seq a
Seq.singleton (HashQualified Name
-> a -> ResolutionError Reference -> ResolutionFailure a
forall annotation.
HashQualified Name
-> annotation
-> ResolutionError Reference
-> ResolutionFailure annotation
Names.TypeResolutionFailure HashQualified Name
hqName a
a ResolutionError Reference
forall ref. ResolutionError ref
Names.NotFound))
              | Bool
otherwise -> Seq (ResolutionFailure a) -> ResolutionResult a (v, Type v a)
forall a b. a -> Either a b
Left (ResolutionFailure a -> Seq (ResolutionFailure a)
forall a. a -> Seq a
Seq.singleton (HashQualified Name
-> a -> ResolutionError Reference -> ResolutionFailure a
forall annotation.
HashQualified Name
-> annotation
-> ResolutionError Reference
-> ResolutionFailure annotation
Names.TypeResolutionFailure HashQualified Name
hqName a
a (Names -> Set Reference -> Set Name -> ResolutionError Reference
forall ref. Names -> Set ref -> Set Name -> ResolutionError ref
Names.Ambiguous Names
namespace Set Reference
rs Set Name
forall a. Set a
Set.empty)))
          where
            hqName :: HashQualified Name
hqName = Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly (v -> Name
unsafeVarToName v
v)

    let ([(v, Referent)]
namespaceTermResolutions, [(v, Name)]
localTermResolutions) =
          [(v, ResolvesTo Referent)] -> ([(v, Referent)], [(v, Name)])
forall v ref. [(v, ResolvesTo ref)] -> ([(v, ref)], [(v, Name)])
partitionResolutions (((v, a) -> Maybe (v, ResolvesTo Referent))
-> [(v, a)] -> [(v, ResolvesTo Referent)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (v, a) -> Maybe (v, ResolvesTo Referent)
okTm [(v, a)]
freeTmVars)

        termSubsts :: [(v, Term2 v a a v ())]
termSubsts =
          [(v
v, () -> Referent -> Term2 v a a v ()
forall v a vt at ap. Ord v => a -> Referent -> Term2 vt at ap v a
fromReferent () Referent
ref) | (v
v, Referent
ref) <- [(v, Referent)]
namespaceTermResolutions]
            [(v, Term2 v a a v ())]
-> [(v, Term2 v a a v ())] -> [(v, Term2 v a a v ())]
forall a. [a] -> [a] -> [a]
++ [(v
v, () -> v -> Term2 v a a v ()
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var () (Name -> v
nameToVar Name
name)) | (v
v, Name
name) <- [(v, Name)]
localTermResolutions]
    [(v, Type v a)]
typeSubsts <- ((v, a) -> ResolutionResult a (v, Type v a))
-> [(v, a)] -> Either (Seq (ResolutionFailure a)) [(v, Type v a)]
forall e (f :: * -> *) a b.
(Semigroup e, Foldable f) =>
(a -> Either e b) -> f a -> Either e [b]
validate (v, a) -> ResolutionResult a (v, Type v a)
okTy [(v, a)]
freeTyVars
    Term v a -> ResolutionResult a (Term v a)
forall a. a -> Either (Seq (ResolutionFailure a)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v a -> ResolutionResult a (Term v a))
-> Term v a -> ResolutionResult a (Term v a)
forall a b. (a -> b) -> a -> b
$
      Term v a
term
        Term v a -> (Term v a -> Term v a) -> Term v a
forall a b. a -> (a -> b) -> b
& [(v, Term2 v a a v ())] -> Term v a -> Term v a
forall (f :: * -> *) v b a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v b)] -> Term f v a -> Term f v a
ABT.substsInheritAnnotation [(v, Term2 v a a v ())]
termSubsts
        Term v a -> (Term v a -> Term v a) -> Term v a
forall a b. a -> (a -> b) -> b
& [(v, Type v a)] -> Term v a -> Term v a
forall v vt b a.
(Ord v, Var vt) =>
[(vt, Type vt b)] -> Term' vt v a -> Term' vt v a
substTypeVars [(v, Type v a)]
typeSubsts
  where
    resolveTermName :: Name.Name -> Set (ResolvesTo Referent)
    resolveTermName :: Name -> Set (ResolvesTo Referent)
resolveTermName =
      Relation Name Referent
-> Set Name -> Name -> Set (ResolvesTo Referent)
forall ref.
Ord ref =>
Relation Name ref -> Set Name -> Name -> Set (ResolvesTo ref)
Names.resolveName (Names -> Relation Name Referent
Names.terms Names
namespace) ((v -> Name) -> Set v -> Set Name
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map v -> Name
unsafeVarToName Set v
localVars)

-- Prepare a term for type-directed name resolution by replacing
-- any remaining free variables with blanks to be resolved by TDNR
prepareTDNR :: (Var v) => ABT.Term (F vt b ap) v b -> ABT.Term (F vt b ap) v b
prepareTDNR :: forall v vt b ap.
Var v =>
Term (F vt b ap) v b -> Term (F vt b ap) v b
prepareTDNR Term (F vt b ap) v b
t = ((b, Set v) -> b)
-> Term (F vt b ap) v (b, Set v) -> Term (F vt b ap) v b
forall a b.
(a -> b) -> Term (F vt b ap) v a -> Term (F vt b ap) v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, Set v) -> b
forall a b. (a, b) -> a
fst (Term (F vt b ap) v (b, Set v) -> Term (F vt b ap) v b)
-> (Term (F vt b ap) v (b, Set v) -> Term (F vt b ap) v (b, Set v))
-> Term (F vt b ap) v (b, Set v)
-> Term (F vt b ap) v b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term (F vt b ap) v (b, Set v)
 -> Maybe (Term (F vt b ap) v (b, Set v)))
-> Term (F vt b ap) v (b, Set v) -> Term (F vt b ap) v (b, Set v)
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 vt b ap) v (b, Set v)
-> Maybe (Term (F vt b ap) v (b, Set v))
forall {v} {v} {f :: * -> *} {ab} {vt} {ap}.
(Var v, Ord v) =>
Term f v (ab, Set v) -> Maybe (Term2 vt ab ap v (ab, Set v))
f (Term (F vt b ap) v (b, Set v) -> Term (F vt b ap) v b)
-> Term (F vt b ap) v (b, Set v) -> Term (F vt b ap) v b
forall a b. (a -> b) -> a -> b
$ Term (F vt b ap) v b -> Term (F vt b ap) v (b, Set v)
forall v (f :: * -> *) a.
(Ord v, Foldable f, Functor f) =>
Term f v a -> Term f v (a, Set v)
ABT.annotateBound Term (F vt b ap) v b
t
  where
    f :: Term f v (ab, Set v) -> Maybe (Term2 vt ab ap v (ab, Set v))
f (ABT.Term Set v
_ (ab
a, Set v
bound) (ABT.Var v
v))
      | v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember v
v Set v
bound =
          if v -> Type
forall v. Var v => v -> Type
Var.typeOf v
v Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
Var.MissingResult
            then Term2 vt ab ap v (ab, Set v)
-> Maybe (Term2 vt ab ap v (ab, Set v))
forall a. a -> Maybe a
Just (Term2 vt ab ap v (ab, Set v)
 -> Maybe (Term2 vt ab ap v (ab, Set v)))
-> Term2 vt ab ap v (ab, Set v)
-> Maybe (Term2 vt ab ap v (ab, Set v))
forall a b. (a -> b) -> a -> b
$ (ab, Set v) -> ab -> Term2 vt ab ap v (ab, Set v)
forall v at ab vt ap. Ord v => at -> ab -> Term2 vt ab ap v at
missingResult (ab
a, Set v
bound) ab
a
            else Term2 vt ab ap v (ab, Set v)
-> Maybe (Term2 vt ab ap v (ab, Set v))
forall a. a -> Maybe a
Just (Term2 vt ab ap v (ab, Set v)
 -> Maybe (Term2 vt ab ap v (ab, Set v)))
-> Term2 vt ab ap v (ab, Set v)
-> Maybe (Term2 vt ab ap v (ab, Set v))
forall a b. (a -> b) -> a -> b
$ (ab, Set v) -> ab -> String -> Term2 vt ab ap v (ab, Set v)
forall v at ab vt ap.
Ord v =>
at -> ab -> String -> Term2 vt ab ap v at
resolve (ab
a, Set v
bound) ab
a (Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ v -> Text
forall v. Var v => v -> Text
Var.name v
v)
    f Term f v (ab, Set v)
_ = Maybe (Term2 vt ab ap v (ab, Set v))
forall a. Maybe a
Nothing

amap :: (Ord v) => (a -> a2) -> Term v a -> Term v a2
amap :: forall v a a2. Ord v => (a -> a2) -> Term v a -> Term v a2
amap a -> a2
f = (a -> a2) -> Term (F v a2 a2) v a -> Term (F v a2 a2) v a2
forall a b.
(a -> b) -> Term (F v a2 a2) v a -> Term (F v a2 a2) v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a2
f (Term (F v a2 a2) v a -> Term (F v a2 a2) v a2)
-> (Term v a -> Term (F v a2 a2) v a)
-> Term v a
-> Term (F v a2 a2) v a2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern a -> Pattern a2)
-> Term2 v a2 a v a -> Term (F v a2 a2) v a
forall ap ap2 vt at v a.
(Pattern ap -> Pattern ap2)
-> Term2 vt at ap v a -> Term2 vt at ap2 v a
patternMap ((a -> a2) -> Pattern a -> Pattern a2
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a2
f) (Term2 v a2 a v a -> Term (F v a2 a2) v a)
-> (Term v a -> Term2 v a2 a v a)
-> Term v a
-> Term (F v a2 a2) v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type v a -> Type v a2) -> Term v a -> Term2 v a2 a v a
forall vt2 vt at at2 ap v a.
Ord vt2 =>
(Type vt at -> Type vt2 at2)
-> Term2 vt at ap v a -> Term2 vt2 at2 ap v a
typeMap ((a -> a2) -> Type v a -> Type v a2
forall a b. (a -> b) -> Term F v a -> Term F v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a2
f)

patternMap :: (Pattern ap -> Pattern ap2) -> Term2 vt at ap v a -> Term2 vt at ap2 v a
patternMap :: forall ap ap2 vt at v a.
(Pattern ap -> Pattern ap2)
-> Term2 vt at ap v a -> Term2 vt at ap2 v a
patternMap Pattern ap -> Pattern ap2
f = Term (F vt at ap) v a -> Term (F vt at ap2) v a
go
  where
    go :: Term (F vt at ap) v a -> Term (F vt at ap2) v a
go (ABT.Term Set v
fvs a
a ABT (F vt at ap) v (Term (F vt at ap) v a)
t) = Set v
-> a
-> ABT (F vt at ap2) v (Term (F vt at ap2) v a)
-> Term (F vt at ap2) v a
forall (f :: * -> *) v a.
Set v -> a -> ABT f v (Term f v a) -> Term f v a
ABT.Term Set v
fvs a
a (ABT (F vt at ap2) v (Term (F vt at ap2) v a)
 -> Term (F vt at ap2) v a)
-> ABT (F vt at ap2) v (Term (F vt at ap2) v a)
-> Term (F vt at ap2) v a
forall a b. (a -> b) -> a -> b
$ case ABT (F vt at ap) v (Term (F vt at ap) v a)
t of
      ABT.Abs v
v Term (F vt at ap) v a
t -> v
-> Term (F vt at ap2) v a
-> ABT (F vt at ap2) v (Term (F vt at ap2) v a)
forall (f :: * -> *) v r. v -> r -> ABT f v r
ABT.Abs v
v (Term (F vt at ap) v a -> Term (F vt at ap2) v a
go Term (F vt at ap) v a
t)
      ABT.Var v
v -> v -> ABT (F vt at ap2) v (Term (F vt at ap2) v a)
forall (f :: * -> *) v r. v -> ABT f v r
ABT.Var v
v
      ABT.Cycle Term (F vt at ap) v a
t -> Term (F vt at ap2) v a
-> ABT (F vt at ap2) v (Term (F vt at ap2) v a)
forall (f :: * -> *) v r. r -> ABT f v r
ABT.Cycle (Term (F vt at ap) v a -> Term (F vt at ap2) v a
go Term (F vt at ap) v a
t)
      ABT.Tm (Match Term (F vt at ap) v a
e [MatchCase ap (Term (F vt at ap) v a)]
cases) ->
        F vt at ap2 (Term (F vt at ap2) v a)
-> ABT (F vt at ap2) v (Term (F vt at ap2) v a)
forall (f :: * -> *) v r. f r -> ABT f v r
ABT.Tm
          ( Term (F vt at ap2) v a
-> [MatchCase ap2 (Term (F vt at ap2) v a)]
-> F vt at ap2 (Term (F vt at ap2) v a)
forall typeVar typeAnn patternAnn a.
a -> [MatchCase patternAnn a] -> F typeVar typeAnn patternAnn a
Match
              (Term (F vt at ap) v a -> Term (F vt at ap2) v a
go Term (F vt at ap) v a
e)
              [ Pattern ap2
-> Maybe (Term (F vt at ap2) v a)
-> Term (F vt at ap2) v a
-> MatchCase ap2 (Term (F vt at ap2) v a)
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
MatchCase (Pattern ap -> Pattern ap2
f Pattern ap
p) (Term (F vt at ap) v a -> Term (F vt at ap2) v a
go (Term (F vt at ap) v a -> Term (F vt at ap2) v a)
-> Maybe (Term (F vt at ap) v a) -> Maybe (Term (F vt at ap2) v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Term (F vt at ap) v a)
g) (Term (F vt at ap) v a -> Term (F vt at ap2) v a
go Term (F vt at ap) v a
a) | MatchCase Pattern ap
p Maybe (Term (F vt at ap) v a)
g Term (F vt at ap) v a
a <- [MatchCase ap (Term (F vt at ap) v a)]
cases
              ]
          )
      -- Safe since `Match` is only ctor that has embedded `Pattern ap` arg
      ABT.Tm F vt at ap (Term (F vt at ap) v a)
ts -> ABT (F vt at ap) Any (Term (F vt at ap2) v a)
-> ABT (F vt at ap2) v (Term (F vt at ap2) v a)
forall a b. a -> b
unsafeCoerce (ABT (F vt at ap) Any (Term (F vt at ap2) v a)
 -> ABT (F vt at ap2) v (Term (F vt at ap2) v a))
-> ABT (F vt at ap) Any (Term (F vt at ap2) v a)
-> ABT (F vt at ap2) v (Term (F vt at ap2) v a)
forall a b. (a -> b) -> a -> b
$ F vt at ap (Term (F vt at ap2) v a)
-> ABT (F vt at ap) Any (Term (F vt at ap2) v a)
forall (f :: * -> *) v r. f r -> ABT f v r
ABT.Tm ((Term (F vt at ap) v a -> Term (F vt at ap2) v a)
-> F vt at ap (Term (F vt at ap) v a)
-> F vt at ap (Term (F vt at ap2) v a)
forall a b. (a -> b) -> F vt at ap a -> F vt at ap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term (F vt at ap) v a -> Term (F vt at ap2) v a
go F vt at ap (Term (F vt at ap) v a)
ts)

vmap :: (Ord v2) => (v -> v2) -> Term v a -> Term v2 a
vmap :: forall v2 v a. Ord v2 => (v -> v2) -> Term v a -> Term v2 a
vmap v -> v2
f = (v -> v2) -> Term (F v2 a a) v a -> Term (F v2 a a) v2 a
forall (f :: * -> *) v' v a.
(Functor f, Foldable f, Ord v') =>
(v -> v') -> Term f v a -> Term f v' a
ABT.vmap v -> v2
f (Term (F v2 a a) v a -> Term (F v2 a a) v2 a)
-> (Term v a -> Term (F v2 a a) v a)
-> Term v a
-> Term (F v2 a a) v2 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type v a -> Type v2 a) -> Term v a -> Term (F v2 a a) v a
forall vt2 vt at at2 ap v a.
Ord vt2 =>
(Type vt at -> Type vt2 at2)
-> Term2 vt at ap v a -> Term2 vt2 at2 ap v a
typeMap ((v -> v2) -> Type v a -> Type v2 a
forall (f :: * -> *) v' v a.
(Functor f, Foldable f, Ord v') =>
(v -> v') -> Term f v a -> Term f v' a
ABT.vmap v -> v2
f)

vtmap :: (Ord vt2) => (vt -> vt2) -> Term' vt v a -> Term' vt2 v a
vtmap :: forall vt2 vt v a.
Ord vt2 =>
(vt -> vt2) -> Term' vt v a -> Term' vt2 v a
vtmap vt -> vt2
f = (Type vt a -> Type vt2 a) -> Term2 vt a a v a -> Term2 vt2 a a v a
forall vt2 vt at at2 ap v a.
Ord vt2 =>
(Type vt at -> Type vt2 at2)
-> Term2 vt at ap v a -> Term2 vt2 at2 ap v a
typeMap ((vt -> vt2) -> Type vt a -> Type vt2 a
forall (f :: * -> *) v' v a.
(Functor f, Foldable f, Ord v') =>
(v -> v') -> Term f v a -> Term f v' a
ABT.vmap vt -> vt2
f)

typeMap ::
  (Ord vt2) =>
  (Type vt at -> Type vt2 at2) ->
  Term2 vt at ap v a ->
  Term2 vt2 at2 ap v a
typeMap :: forall vt2 vt at at2 ap v a.
Ord vt2 =>
(Type vt at -> Type vt2 at2)
-> Term2 vt at ap v a -> Term2 vt2 at2 ap v a
typeMap Type vt at -> Type vt2 at2
f = Term (F vt at ap) v a -> Term (F vt2 at2 ap) v a
go
  where
    go :: Term (F vt at ap) v a -> Term (F vt2 at2 ap) v a
go (ABT.Term Set v
fvs a
a ABT (F vt at ap) v (Term (F vt at ap) v a)
t) = Set v
-> a
-> ABT (F vt2 at2 ap) v (Term (F vt2 at2 ap) v a)
-> Term (F vt2 at2 ap) v a
forall (f :: * -> *) v a.
Set v -> a -> ABT f v (Term f v a) -> Term f v a
ABT.Term Set v
fvs a
a (ABT (F vt2 at2 ap) v (Term (F vt2 at2 ap) v a)
 -> Term (F vt2 at2 ap) v a)
-> ABT (F vt2 at2 ap) v (Term (F vt2 at2 ap) v a)
-> Term (F vt2 at2 ap) v a
forall a b. (a -> b) -> a -> b
$ case ABT (F vt at ap) v (Term (F vt at ap) v a)
t of
      ABT.Abs v
v Term (F vt at ap) v a
t -> v
-> Term (F vt2 at2 ap) v a
-> ABT (F vt2 at2 ap) v (Term (F vt2 at2 ap) v a)
forall (f :: * -> *) v r. v -> r -> ABT f v r
ABT.Abs v
v (Term (F vt at ap) v a -> Term (F vt2 at2 ap) v a
go Term (F vt at ap) v a
t)
      ABT.Var v
v -> v -> ABT (F vt2 at2 ap) v (Term (F vt2 at2 ap) v a)
forall (f :: * -> *) v r. v -> ABT f v r
ABT.Var v
v
      ABT.Cycle Term (F vt at ap) v a
t -> Term (F vt2 at2 ap) v a
-> ABT (F vt2 at2 ap) v (Term (F vt2 at2 ap) v a)
forall (f :: * -> *) v r. r -> ABT f v r
ABT.Cycle (Term (F vt at ap) v a -> Term (F vt2 at2 ap) v a
go Term (F vt at ap) v a
t)
      ABT.Tm (Ann Term (F vt at ap) v a
e Type vt at
t) -> F vt2 at2 ap (Term (F vt2 at2 ap) v a)
-> ABT (F vt2 at2 ap) v (Term (F vt2 at2 ap) v a)
forall (f :: * -> *) v r. f r -> ABT f v r
ABT.Tm (Term (F vt2 at2 ap) v a
-> Type vt2 at2 -> F vt2 at2 ap (Term (F vt2 at2 ap) v a)
forall typeVar typeAnn patternAnn a.
a -> Type typeVar typeAnn -> F typeVar typeAnn patternAnn a
Ann (Term (F vt at ap) v a -> Term (F vt2 at2 ap) v a
go Term (F vt at ap) v a
e) (Type vt at -> Type vt2 at2
f Type vt at
t))
      -- Safe since `Ann` is only ctor that has embedded `Type v` arg
      -- otherwise we'd have to manually match on every non-`Ann` ctor
      ABT.Tm F vt at ap (Term (F vt at ap) v a)
ts -> ABT (F vt at ap) Any (Term (F vt2 at2 ap) v a)
-> ABT (F vt2 at2 ap) v (Term (F vt2 at2 ap) v a)
forall a b. a -> b
unsafeCoerce (ABT (F vt at ap) Any (Term (F vt2 at2 ap) v a)
 -> ABT (F vt2 at2 ap) v (Term (F vt2 at2 ap) v a))
-> ABT (F vt at ap) Any (Term (F vt2 at2 ap) v a)
-> ABT (F vt2 at2 ap) v (Term (F vt2 at2 ap) v a)
forall a b. (a -> b) -> a -> b
$ F vt at ap (Term (F vt2 at2 ap) v a)
-> ABT (F vt at ap) Any (Term (F vt2 at2 ap) v a)
forall (f :: * -> *) v r. f r -> ABT f v r
ABT.Tm ((Term (F vt at ap) v a -> Term (F vt2 at2 ap) v a)
-> F vt at ap (Term (F vt at ap) v a)
-> F vt at ap (Term (F vt2 at2 ap) v a)
forall a b. (a -> b) -> F vt at ap a -> F vt at ap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term (F vt at ap) v a -> Term (F vt2 at2 ap) v a
go F vt at ap (Term (F vt at ap) v a)
ts)

extraMap' ::
  (Ord vt, Ord vt') =>
  (vt -> vt') ->
  (at -> at') ->
  (ap -> ap') ->
  Term2 vt at ap v a ->
  Term2 vt' at' ap' v a
extraMap' :: forall vt vt' at at' ap ap' v a.
(Ord vt, Ord vt') =>
(vt -> vt')
-> (at -> at')
-> (ap -> ap')
-> Term2 vt at ap v a
-> Term2 vt' at' ap' v a
extraMap' vt -> vt'
vtf at -> at'
atf ap -> ap'
apf = (forall k. F vt at ap k -> F vt' at' ap' k)
-> Term (F vt at ap) v a -> Term (F vt' at' ap') v a
forall (g :: * -> *) (f :: * -> *) v a.
Functor g =>
(forall k. f k -> g k) -> Term f v a -> Term g v a
ABT.extraMap ((vt -> vt')
-> (at -> at') -> (ap -> ap') -> F vt at ap k -> F vt' at' ap' k
forall vt vt' at at' ap ap' a.
(Ord vt, Ord vt') =>
(vt -> vt')
-> (at -> at') -> (ap -> ap') -> F vt at ap a -> F vt' at' ap' a
extraMap vt -> vt'
vtf at -> at'
atf ap -> ap'
apf)

extraMap ::
  (Ord vt, Ord vt') =>
  (vt -> vt') ->
  (at -> at') ->
  (ap -> ap') ->
  F vt at ap a ->
  F vt' at' ap' a
extraMap :: forall vt vt' at at' ap ap' a.
(Ord vt, Ord vt') =>
(vt -> vt')
-> (at -> at') -> (ap -> ap') -> F vt at ap a -> F vt' at' ap' a
extraMap vt -> vt'
vtf at -> at'
atf ap -> ap'
apf = \case
  Int Int64
x -> Int64 -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
Int64 -> F typeVar typeAnn patternAnn a
Int Int64
x
  Nat Word64
x -> Word64 -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
Word64 -> F typeVar typeAnn patternAnn a
Nat Word64
x
  Float Double
x -> Double -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
Double -> F typeVar typeAnn patternAnn a
Float Double
x
  Boolean Bool
x -> Bool -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
Bool -> F typeVar typeAnn patternAnn a
Boolean Bool
x
  Text Text
x -> Text -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
Text -> F typeVar typeAnn patternAnn a
Text Text
x
  Char Char
x -> Char -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
Char -> F typeVar typeAnn patternAnn a
Char Char
x
  Blank Blank at
x -> Blank at' -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
Blank typeAnn -> F typeVar typeAnn patternAnn a
Blank ((at -> at') -> Blank at -> Blank at'
forall a b. (a -> b) -> Blank a -> Blank b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap at -> at'
atf Blank at
x)
  Ref Reference
x -> Reference -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
Reference -> F typeVar typeAnn patternAnn a
Ref Reference
x
  Constructor ConstructorReference
x -> ConstructorReference -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
ConstructorReference -> F typeVar typeAnn patternAnn a
Constructor ConstructorReference
x
  Request ConstructorReference
x -> ConstructorReference -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
ConstructorReference -> F typeVar typeAnn patternAnn a
Request ConstructorReference
x
  Handle a
x a
y -> a -> a -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
Handle a
x a
y
  App a
x a
y -> a -> a -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
App a
x a
y
  Ann a
tm Type vt at
x -> a -> Type vt' at' -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
a -> Type typeVar typeAnn -> F typeVar typeAnn patternAnn a
Ann a
tm ((at -> at') -> Term F vt' at -> Type vt' at'
forall (f :: * -> *) v a a2.
(Functor f, Foldable f, Ord v) =>
(a -> a2) -> Term f v a -> Term f v a2
ABT.amap at -> at'
atf ((vt -> vt') -> Type vt at -> Term F vt' at
forall (f :: * -> *) v' v a.
(Functor f, Foldable f, Ord v') =>
(v -> v') -> Term f v a -> Term f v' a
ABT.vmap vt -> vt'
vtf Type vt at
x))
  List Seq a
x -> Seq a -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
Seq a -> F typeVar typeAnn patternAnn a
List Seq a
x
  If a
x a
y a
z -> a -> a -> a -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
a -> a -> a -> F typeVar typeAnn patternAnn a
If a
x a
y a
z
  And a
x a
y -> a -> a -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
And a
x a
y
  Or a
x a
y -> a -> a -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
Or a
x a
y
  Lam a
x -> a -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
a -> F typeVar typeAnn patternAnn a
Lam a
x
  LetRec Bool
x [a]
y a
z -> Bool -> [a] -> a -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
Bool -> [a] -> a -> F typeVar typeAnn patternAnn a
LetRec Bool
x [a]
y a
z
  Let Bool
x a
y a
z -> Bool -> a -> a -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
Bool -> a -> a -> F typeVar typeAnn patternAnn a
Let Bool
x a
y a
z
  Match a
tm [MatchCase ap a]
l -> a -> [MatchCase ap' a] -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
a -> [MatchCase patternAnn a] -> F typeVar typeAnn patternAnn a
Match a
tm ((MatchCase ap a -> MatchCase ap' a)
-> [MatchCase ap a] -> [MatchCase ap' a]
forall a b. (a -> b) -> [a] -> [b]
map ((ap -> ap') -> MatchCase ap a -> MatchCase ap' a
forall loc loc' a.
(loc -> loc') -> MatchCase loc a -> MatchCase loc' a
matchCaseExtraMap ap -> ap'
apf) [MatchCase ap a]
l)
  TermLink Referent
r -> Referent -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
Referent -> F typeVar typeAnn patternAnn a
TermLink Referent
r
  TypeLink Reference
r -> Reference -> F vt' at' ap' a
forall typeVar typeAnn patternAnn a.
Reference -> F typeVar typeAnn patternAnn a
TypeLink Reference
r

matchCaseExtraMap :: (loc -> loc') -> MatchCase loc a -> MatchCase loc' a
matchCaseExtraMap :: forall loc loc' a.
(loc -> loc') -> MatchCase loc a -> MatchCase loc' a
matchCaseExtraMap loc -> loc'
f (MatchCase Pattern loc
p Maybe a
x a
y) = Pattern loc' -> Maybe a -> a -> MatchCase loc' a
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
MatchCase ((loc -> loc') -> Pattern loc -> Pattern loc'
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap loc -> loc'
f Pattern loc
p) Maybe a
x a
y

unannotate ::
  forall vt at ap v a. (Ord v) => Term2 vt at ap v a -> Term0' vt v
unannotate :: forall vt at ap v a. Ord v => Term2 vt at ap v a -> Term0' vt v
unannotate = Term2 vt at ap v a -> Term0' vt v
go
  where
    go :: Term2 vt at ap v a -> Term0' vt v
    go :: Term2 vt at ap v a -> Term0' vt v
go (Term2 vt at ap v a -> ABT (F vt at ap) v (Term2 vt at ap v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out -> ABT.Abs v
v Term2 vt at ap v a
body) = v -> Term0' vt v -> Term0' vt v
forall v (f :: * -> *). Ord v => v -> Term f v () -> Term f v ()
ABT.abs v
v (Term2 vt at ap v a -> Term0' vt v
go Term2 vt at ap v a
body)
    go (Term2 vt at ap v a -> ABT (F vt at ap) v (Term2 vt at ap v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out -> ABT.Cycle Term2 vt at ap v a
body) = Term0' vt v -> Term0' vt v
forall (f :: * -> *) v. Term f v () -> Term f v ()
ABT.cycle (Term2 vt at ap v a -> Term0' vt v
go Term2 vt at ap v a
body)
    go (ABT.Var' v
v) = v -> Term0' vt v
forall v (f :: * -> *). v -> Term f v ()
ABT.var v
v
    go (ABT.Tm' F vt at ap (Term2 vt at ap v a)
f) = case Term2 vt at ap v a -> Term0' vt v
go (Term2 vt at ap v a -> Term0' vt v)
-> F vt at ap (Term2 vt at ap v a) -> F vt at ap (Term0' vt v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> F vt at ap (Term2 vt at ap v a)
f of
      Ann Term0' vt v
e Type vt at
t -> F vt () () (Term0' vt v) -> Term0' vt v
forall (f :: * -> *) v.
(Foldable f, Ord v) =>
f (Term f v ()) -> Term f v ()
ABT.tm (Term0' vt v -> Type vt () -> F vt () () (Term0' vt v)
forall typeVar typeAnn patternAnn a.
a -> Type typeVar typeAnn -> F typeVar typeAnn patternAnn a
Ann Term0' vt v
e (Type vt at -> Type vt ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Type vt at
t))
      Match Term0' vt v
scrutinee [MatchCase ap (Term0' vt v)]
branches ->
        let unann :: MatchCase a a -> MatchCase () a
unann (MatchCase Pattern a
pat Maybe a
guard a
body) = Pattern () -> Maybe a -> a -> MatchCase () a
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
MatchCase (Pattern a -> Pattern ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Pattern a
pat) Maybe a
guard a
body
         in F vt () () (Term0' vt v) -> Term0' vt v
forall (f :: * -> *) v.
(Foldable f, Ord v) =>
f (Term f v ()) -> Term f v ()
ABT.tm (Term0' vt v
-> [MatchCase () (Term0' vt v)] -> F vt () () (Term0' vt v)
forall typeVar typeAnn patternAnn a.
a -> [MatchCase patternAnn a] -> F typeVar typeAnn patternAnn a
Match Term0' vt v
scrutinee (MatchCase ap (Term0' vt v) -> MatchCase () (Term0' vt v)
forall {a} {a}. MatchCase a a -> MatchCase () a
unann (MatchCase ap (Term0' vt v) -> MatchCase () (Term0' vt v))
-> [MatchCase ap (Term0' vt v)] -> [MatchCase () (Term0' vt v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MatchCase ap (Term0' vt v)]
branches))
      F vt at ap (Term0' vt v)
f' -> F vt () () (Term0' vt v) -> Term0' vt v
forall (f :: * -> *) v.
(Foldable f, Ord v) =>
f (Term f v ()) -> Term f v ()
ABT.tm (F vt at ap (Term0' vt v) -> F vt () () (Term0' vt v)
forall a b. a -> b
unsafeCoerce F vt at ap (Term0' vt v)
f')
    go Term2 vt at ap v a
_ = String -> Term0' vt v
forall a. HasCallStack => String -> a
error String
"unpossible"

wrapV :: (Ord v) => Term v a -> Term (ABT.V v) a
wrapV :: forall v a. Ord v => Term v a -> Term (V v) a
wrapV = (v -> V v) -> Term v a -> Term (V v) a
forall v2 v a. Ord v2 => (v -> v2) -> Term v a -> Term v2 a
vmap v -> V v
forall v. v -> V v
ABT.Bound

-- | All variables mentioned in the given term.
-- Includes both term and type variables, both free and bound.
allVars :: (Ord v) => Term v a -> Set v
allVars :: forall v a. Ord v => Term v a -> Set v
allVars Term v a
tm =
  [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
$
    Term v a -> [v]
forall (f :: * -> *) v a. Foldable f => Term f v a -> [v]
ABT.allVars Term v a
tm [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
++ [v
v | Type v a
tp <- Term v a -> [Type v a]
forall {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a -> [Type typeVar typeAnn]
allTypes Term v a
tm, v
v <- Type v a -> [v]
forall (f :: * -> *) v a. Foldable f => Term f v a -> [v]
ABT.allVars Type v a
tp]
  where
    allTypes :: Term (F typeVar typeAnn patternAnn) v a -> [Type typeVar typeAnn]
allTypes Term (F typeVar typeAnn patternAnn) v a
tm = case Term (F typeVar typeAnn patternAnn) v a
tm of
      Ann' Term (F typeVar typeAnn patternAnn) v a
e Type typeVar typeAnn
tp -> Type typeVar typeAnn
tp Type typeVar typeAnn
-> [Type typeVar typeAnn] -> [Type typeVar typeAnn]
forall a. a -> [a] -> [a]
: Term (F typeVar typeAnn patternAnn) v a -> [Type typeVar typeAnn]
allTypes Term (F typeVar typeAnn patternAnn) v a
e
      Term (F typeVar typeAnn patternAnn) v a
_ -> (Term (F typeVar typeAnn patternAnn) v a -> [Type typeVar typeAnn])
-> ABT
     (F typeVar typeAnn patternAnn)
     v
     (Term (F typeVar typeAnn patternAnn) v a)
-> [Type typeVar typeAnn]
forall m a.
Monoid m =>
(a -> m) -> ABT (F typeVar typeAnn patternAnn) v a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term (F typeVar typeAnn patternAnn) v a -> [Type typeVar typeAnn]
allTypes (ABT
   (F typeVar typeAnn patternAnn)
   v
   (Term (F typeVar typeAnn patternAnn) v a)
 -> [Type typeVar typeAnn])
-> ABT
     (F typeVar typeAnn patternAnn)
     v
     (Term (F typeVar typeAnn patternAnn) v a)
-> [Type typeVar typeAnn]
forall a b. (a -> b) -> a -> b
$ Term (F typeVar typeAnn patternAnn) v a
-> ABT
     (F typeVar typeAnn patternAnn)
     v
     (Term (F typeVar typeAnn patternAnn) v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out Term (F typeVar typeAnn patternAnn) v a
tm

freeVars :: Term' vt v a -> Set v
freeVars :: forall vt v a. Term' vt v a -> Set v
freeVars = Term (F vt a a) v a -> Set v
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars

freeTypeVars :: (Ord vt) => Term' vt v a -> Set vt
freeTypeVars :: forall vt v a. Ord vt => Term' vt v a -> Set vt
freeTypeVars Term' vt v a
t = Map vt [a] -> Set vt
forall k a. Map k a -> Set k
Map.keysSet (Map vt [a] -> Set vt) -> Map vt [a] -> Set vt
forall a b. (a -> b) -> a -> b
$ Term' vt v a -> Map vt [a]
forall vt v a. Ord vt => Term' vt v a -> Map vt [a]
freeTypeVarAnnotations Term' vt v a
t

freeTypeVarAnnotations :: (Ord vt) => Term' vt v a -> Map vt [a]
freeTypeVarAnnotations :: forall vt v a. Ord vt => Term' vt v a -> Map vt [a]
freeTypeVarAnnotations Term' vt v a
e = [(vt, a)] -> Map vt [a]
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
f (k, v) -> Map k [v]
multimap ([(vt, a)] -> Map vt [a]) -> [(vt, a)] -> Map vt [a]
forall a b. (a -> b) -> a -> b
$ Set vt -> Term' vt v a -> [(vt, a)]
forall {v} {a} {patternAnn} {v} {a}.
Ord v =>
Set v -> Term (F v a patternAnn) v a -> [(v, a)]
go Set vt
forall a. Set a
Set.empty Term' vt v a
e
  where
    go :: Set v -> Term (F v a patternAnn) v a -> [(v, a)]
go Set v
bound Term (F v a patternAnn) v a
tm = case Term (F v a patternAnn) v a
tm of
      Var' v
_ -> [(v, a)]
forall a. Monoid a => a
mempty
      Ann' Term (F v a patternAnn) v a
e (Type v a -> Type v a
forall v a. Type v a -> Type v a
Type.stripIntroOuters -> Type v a
t1) ->
        let bound' :: Set v
bound' = case Type v a
t1 of
              Type.ForallsNamed' [v]
vs Type v a
_ -> Set v
bound Set v -> Set v -> Set v
forall a. Semigroup a => a -> a -> a
<> [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [v]
vs
              Type v a
_ -> Set v
bound
         in Set v -> Term (F v a patternAnn) v a -> [(v, a)]
go Set v
bound' Term (F v a patternAnn) v a
e [(v, a)] -> [(v, a)] -> [(v, a)]
forall a. Semigroup a => a -> a -> a
<> Set v -> Type v a -> [(v, a)]
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
Set v -> Term f v a -> [(v, a)]
ABT.freeVarOccurrences Set v
bound Type v a
t1
      ABT.Tm' F v a patternAnn (Term (F v a patternAnn) v a)
f -> (Term (F v a patternAnn) v a -> [(v, a)])
-> F v a patternAnn (Term (F v a patternAnn) v a) -> [(v, a)]
forall m a. Monoid m => (a -> m) -> F v a patternAnn a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Set v -> Term (F v a patternAnn) v a -> [(v, a)]
go Set v
bound) F v a patternAnn (Term (F v a patternAnn) v a)
f
      (Term (F v a patternAnn) v a
-> ABT (F v a patternAnn) v (Term (F v a patternAnn) v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out -> ABT.Abs v
_ Term (F v a patternAnn) v a
body) -> Set v -> Term (F v a patternAnn) v a -> [(v, a)]
go Set v
bound Term (F v a patternAnn) v a
body
      (Term (F v a patternAnn) v a
-> ABT (F v a patternAnn) v (Term (F v a patternAnn) v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out -> ABT.Cycle Term (F v a patternAnn) v a
body) -> Set v -> Term (F v a patternAnn) v a -> [(v, a)]
go Set v
bound Term (F v a patternAnn) v a
body
      Term (F v a patternAnn) v a
_ -> String -> [(v, a)]
forall a. HasCallStack => String -> a
error String
"unpossible"

substTypeVars ::
  (Ord v, Var vt) =>
  [(vt, Type vt b)] ->
  Term' vt v a ->
  Term' vt v a
substTypeVars :: forall v vt b a.
(Ord v, Var vt) =>
[(vt, Type vt b)] -> Term' vt v a -> Term' vt v a
substTypeVars [(vt, Type vt b)]
subs Term' vt v a
e = (Term' vt v a -> (vt, Type vt b) -> Term' vt v a)
-> Term' vt v a -> [(vt, Type vt b)] -> Term' vt v a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Term' vt v a -> (vt, Type vt b) -> Term' vt v a
forall {vt} {v} {a} {b}.
(Var vt, Ord v) =>
Term' vt v a -> (vt, Type vt b) -> Term' vt v a
go Term' vt v a
e [(vt, Type vt b)]
subs
  where
    go :: Term' vt v a -> (vt, Type vt b) -> Term' vt v a
go Term' vt v a
e (vt
vt, Type vt b
t) = vt -> Type vt b -> Term' vt v a -> Term' vt v a
forall v vt b a.
(Ord v, Var vt) =>
vt -> Type vt b -> Term' vt v a -> Term' vt v a
substTypeVar vt
vt Type vt b
t Term' vt v a
e

-- Capture-avoiding substitution of a type variable inside a term. This
-- will replace that type variable wherever it appears in type signatures of
-- the term, avoiding capture by renaming ∀-binders.
substTypeVar ::
  (Ord v, ABT.Var vt) =>
  vt ->
  Type vt b ->
  Term' vt v a ->
  Term' vt v a
substTypeVar :: forall v vt b a.
(Ord v, Var vt) =>
vt -> Type vt b -> Term' vt v a -> Term' vt v a
substTypeVar vt
vt Type vt b
ty = Set vt -> Term' vt v a -> Term' vt v a
go Set vt
forall a. Set a
Set.empty
  where
    go :: Set vt -> Term' vt v a -> Term' vt v a
go Set vt
bound Term' vt v a
tm | vt -> Set vt -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member vt
vt Set vt
bound = Term' vt v a
tm
    go Set vt
bound Term' vt v a
tm =
      let loc :: a
loc = Term' vt v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term' vt v a
tm
       in case Term' vt v a
tm of
            Var' v
_ -> Term' vt v a
tm
            Ann' Term' vt v a
e Type vt a
t -> [(a, vt)] -> Term' vt v a -> Type vt a -> Term' vt v a
uncapture [] Term' vt v a
e (Type vt a -> Type vt a
forall v a. Type v a -> Type v a
Type.stripIntroOuters Type vt a
t)
              where
                fvs :: Set vt
fvs = Type vt b -> Set vt
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars Type vt b
ty
                -- if the ∀ introduces a variable, v, which is free in `ty`, we pick a new
                -- variable name for v which is unique, v', and rename v to v' in e.
                uncapture :: [(a, vt)] -> Term' vt v a -> Type vt a -> Term' vt v a
uncapture [(a, vt)]
vs Term' vt v a
e t :: Type vt a
t@(Type.Forall' Subst F vt a
body)
                  | vt -> Set vt -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Subst F vt a -> vt
forall (f :: * -> *) v a. Subst f v a -> v
ABT.variable Subst F vt a
body) Set vt
fvs =
                      let v :: vt
v = Subst F vt a -> vt
forall (f :: * -> *) v a. Subst f v a -> v
ABT.variable Subst F vt a
body
                          v2 :: vt
v2 = Set vt -> vt -> vt
forall v. Var v => Set v -> v -> v
Var.freshIn (Type vt a -> Set vt
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars Type vt a
t) (vt -> vt) -> (vt -> vt) -> vt -> vt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set vt -> vt -> vt
forall v. Var v => Set v -> v -> v
Var.freshIn (vt -> Set vt -> Set vt
forall a. Ord a => a -> Set a -> Set a
Set.insert vt
vt Set vt
fvs) (vt -> vt) -> vt -> vt
forall a b. (a -> b) -> a -> b
$ vt
v
                          t2 :: Type vt a
t2 = Subst F vt a -> forall b. Term F vt b -> Type vt a
forall (f :: * -> *) v a.
Subst f v a -> forall b. Term f v b -> Term f v a
ABT.bindInheritAnnotation Subst F vt a
body (() -> vt -> Term F vt ()
forall v a. Ord v => a -> v -> Type v a
Type.var () vt
v2)
                       in [(a, vt)] -> Term' vt v a -> Type vt a -> Term' vt v a
uncapture ((Type vt a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Type vt a
t, vt
v2) (a, vt) -> [(a, vt)] -> [(a, vt)]
forall a. a -> [a] -> [a]
: [(a, vt)]
vs) (vt -> vt -> Term' vt v a -> Term' vt v a
forall v vt a.
(Ord v, Var vt) =>
vt -> vt -> Term' vt v a -> Term' vt v a
renameTypeVar vt
v vt
v2 Term' vt v a
e) Type vt a
t2
                uncapture [(a, vt)]
vs Term' vt v a
e Type vt a
t0 =
                  let t :: Type vt a
t = (Type vt a -> (a, vt) -> Type vt a)
-> Type vt a -> [(a, vt)] -> Type vt a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Type vt a
body (a
loc, vt
v) -> a -> vt -> Type vt a -> Type vt a
forall v a. Ord v => a -> v -> Type v a -> Type v a
Type.forAll a
loc vt
v Type vt a
body) Type vt a
t0 [(a, vt)]
vs
                      bound' :: Set vt
bound' = case Type vt a -> Maybe ([vt], Type vt a)
forall v a. Type v a -> Maybe ([v], Type v a)
Type.unForalls (Type vt a -> Type vt a
forall v a. Type v a -> Type v a
Type.stripIntroOuters Type vt a
t) of
                        Maybe ([vt], Type vt a)
Nothing -> Set vt
bound
                        Just ([vt]
vs, Type vt a
_) -> Set vt
bound Set vt -> Set vt -> Set vt
forall a. Semigroup a => a -> a -> a
<> [vt] -> Set vt
forall a. Ord a => [a] -> Set a
Set.fromList [vt]
vs
                      t' :: Type vt a
t' = vt -> Type vt b -> Type vt a -> Type vt a
forall (f :: * -> *) v b a.
(Foldable f, Functor f, Var v) =>
v -> Term f v b -> Term f v a -> Term f v a
ABT.substInheritAnnotation vt
vt Type vt b
ty (Type vt a -> Type vt a
forall v a. Type v a -> Type v a
Type.stripIntroOuters Type vt a
t)
                   in a -> Term' vt v a -> Type vt a -> Term' vt 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
loc (Set vt -> Term' vt v a -> Term' vt v a
go Set vt
bound' Term' vt v a
e) (Set vt -> Type vt a -> Type vt a
forall v a. Ord v => Set v -> Type v a -> Type v a
Type.freeVarsToOuters Set vt
bound Type vt a
t')
            ABT.Tm' F vt a a (Term' vt v a)
f -> a -> F vt a a (Term' vt v a) -> Term' vt v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
loc (Set vt -> Term' vt v a -> Term' vt v a
go Set vt
bound (Term' vt v a -> Term' vt v a)
-> F vt a a (Term' vt v a) -> F vt a a (Term' vt v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> F vt a a (Term' vt v a)
f)
            (Term' vt v a -> ABT (F vt a a) v (Term' vt v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out -> ABT.Abs v
v Term' vt v a
body) -> a -> v -> Term' vt v a -> Term' vt v a
forall v a (f :: * -> *).
Ord v =>
a -> v -> Term f v a -> Term f v a
ABT.abs' a
loc v
v (Set vt -> Term' vt v a -> Term' vt v a
go Set vt
bound Term' vt v a
body)
            (Term' vt v a -> ABT (F vt a a) v (Term' vt v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out -> ABT.Cycle Term' vt v a
body) -> a -> Term' vt v a -> Term' vt v a
forall a (f :: * -> *) v. a -> Term f v a -> Term f v a
ABT.cycle' a
loc (Set vt -> Term' vt v a -> Term' vt v a
go Set vt
bound Term' vt v a
body)
            Term' vt v a
_ -> String -> Term' vt v a
forall a. HasCallStack => String -> a
error String
"unpossible"

renameTypeVar :: (Ord v, ABT.Var vt) => vt -> vt -> Term' vt v a -> Term' vt v a
renameTypeVar :: forall v vt a.
(Ord v, Var vt) =>
vt -> vt -> Term' vt v a -> Term' vt v a
renameTypeVar vt
old vt
new = Set vt -> Term (F vt a a) v a -> Term (F vt a a) v a
go Set vt
forall a. Set a
Set.empty
  where
    go :: Set vt -> Term (F vt a a) v a -> Term (F vt a a) v a
go Set vt
bound Term (F vt a a) v a
tm | vt -> Set vt -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member vt
old Set vt
bound = Term (F vt a a) v a
tm
    go Set vt
bound Term (F vt a a) v a
tm =
      let loc :: a
loc = Term (F vt a a) v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term (F vt a a) v a
tm
       in case Term (F vt a a) v a
tm of
            Var' v
_ -> Term (F vt a a) v a
tm
            Ann' Term (F vt a a) v a
e Type vt a
t ->
              let bound' :: Set vt
bound' = case Type vt a -> Maybe ([vt], Type vt a)
forall v a. Type v a -> Maybe ([v], Type v a)
Type.unForalls (Type vt a -> Type vt a
forall v a. Type v a -> Type v a
Type.stripIntroOuters Type vt a
t) of
                    Maybe ([vt], Type vt a)
Nothing -> Set vt
bound
                    Just ([vt]
vs, Type vt a
_) -> Set vt
bound Set vt -> Set vt -> Set vt
forall a. Semigroup a => a -> a -> a
<> [vt] -> Set vt
forall a. Ord a => [a] -> Set a
Set.fromList [vt]
vs
                  t' :: Type vt a
t' = vt -> vt -> Type vt a -> Type vt a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
v -> v -> Term f v a -> Term f v a
ABT.rename vt
old vt
new (Type vt a -> Type vt a
forall v a. Type v a -> Type v a
Type.stripIntroOuters Type vt a
t)
               in a -> Term (F vt a a) v a -> Type vt a -> Term (F vt a a) 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
loc (Set vt -> Term (F vt a a) v a -> Term (F vt a a) v a
go Set vt
bound' Term (F vt a a) v a
e) (Set vt -> Type vt a -> Type vt a
forall v a. Ord v => Set v -> Type v a -> Type v a
Type.freeVarsToOuters Set vt
bound Type vt a
t')
            ABT.Tm' F vt a a (Term (F vt a a) v a)
f -> a -> F vt a a (Term (F vt a a) v a) -> Term (F vt a a) v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
loc (Set vt -> Term (F vt a a) v a -> Term (F vt a a) v a
go Set vt
bound (Term (F vt a a) v a -> Term (F vt a a) v a)
-> F vt a a (Term (F vt a a) v a) -> F vt a a (Term (F vt a a) v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> F vt a a (Term (F vt a a) v a)
f)
            (Term (F vt a a) v a -> ABT (F vt a a) v (Term (F vt a a) v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out -> ABT.Abs v
v Term (F vt a a) v a
body) -> a -> v -> Term (F vt a a) v a -> Term (F vt a a) v a
forall v a (f :: * -> *).
Ord v =>
a -> v -> Term f v a -> Term f v a
ABT.abs' a
loc v
v (Set vt -> Term (F vt a a) v a -> Term (F vt a a) v a
go Set vt
bound Term (F vt a a) v a
body)
            (Term (F vt a a) v a -> ABT (F vt a a) v (Term (F vt a a) v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out -> ABT.Cycle Term (F vt a a) v a
body) -> a -> Term (F vt a a) v a -> Term (F vt a a) v a
forall a (f :: * -> *) v. a -> Term f v a -> Term f v a
ABT.cycle' a
loc (Set vt -> Term (F vt a a) v a -> Term (F vt a a) v a
go Set vt
bound Term (F vt a a) v a
body)
            Term (F vt a a) v a
_ -> String -> Term (F vt a a) v a
forall a. HasCallStack => String -> a
error String
"unpossible"

-- Converts free variables to bound variables using forall or introOuter. Example:
--
-- foo : x -> x
-- foo a =
--   r : x
--   r = a
--   r
--
-- This becomes:
--
-- foo : ∀ x . x -> x
-- foo a =
--   r : outer x . x -- FYI, not valid syntax
--   r = a
--   r
--
-- More specifically: in the expression `e : t`, unbound lowercase variables in `t`
-- are bound with foralls, and any ∀-quantified type variables are made bound in
-- `e` and its subexpressions. The result is a term with no lowercase free
-- variables in any of its type signatures, with outer references represented
-- with explicit `introOuter` binders. The resulting term may have uppercase
-- free variables that are still unbound.
generalizeTypeSignatures :: (Var vt, Var v) => Term' vt v a -> Term' vt v a
generalizeTypeSignatures :: forall vt v a. (Var vt, Var v) => Term' vt v a -> Term' vt v a
generalizeTypeSignatures = Set vt -> Term (F vt a a) v a -> Term (F vt a a) v a
forall {v} {v} {a} {patternAnn} {a}.
(Var v, Ord v) =>
Set v -> Term (F v a patternAnn) v a -> Term (F v a patternAnn) v a
go Set vt
forall a. Set a
Set.empty
  where
    go :: Set v -> Term (F v a patternAnn) v a -> Term (F v a patternAnn) v a
go Set v
bound Term (F v a patternAnn) v a
tm =
      let loc :: a
loc = Term (F v a patternAnn) v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term (F v a patternAnn) v a
tm
       in case Term (F v a patternAnn) v a
tm of
            Var' v
_ -> Term (F v a patternAnn) v a
tm
            Ann' Term (F v a patternAnn) v a
e (Set v -> Type v a -> Type v a
forall v a. Var v => Set v -> Type v a -> Type v a
Type.generalizeLowercase Set v
bound -> Type v a
t) ->
              let bound' :: Set v
bound' = case Type v a -> Maybe ([v], Type v a)
forall v a. Type v a -> Maybe ([v], Type v a)
Type.unForalls Type v a
t of
                    Maybe ([v], Type v a)
Nothing -> Set v
bound
                    Just ([v]
vs, Type v a
_) -> Set v
bound Set v -> Set v -> Set v
forall a. Semigroup a => a -> a -> a
<> [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [v]
vs
               in a
-> Term (F v a patternAnn) v a
-> Type v a
-> Term (F v a patternAnn) 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
loc (Set v -> Term (F v a patternAnn) v a -> Term (F v a patternAnn) v a
go Set v
bound' Term (F v a patternAnn) v a
e) (Set v -> Type v a -> Type v a
forall v a. Ord v => Set v -> Type v a -> Type v a
Type.freeVarsToOuters Set v
bound Type v a
t)
            ABT.Tm' F v a patternAnn (Term (F v a patternAnn) v a)
f -> a
-> F v a patternAnn (Term (F v a patternAnn) v a)
-> Term (F v a patternAnn) v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
loc (Set v -> Term (F v a patternAnn) v a -> Term (F v a patternAnn) v a
go Set v
bound (Term (F v a patternAnn) v a -> Term (F v a patternAnn) v a)
-> F v a patternAnn (Term (F v a patternAnn) v a)
-> F v a patternAnn (Term (F v a patternAnn) v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> F v a patternAnn (Term (F v a patternAnn) v a)
f)
            (Term (F v a patternAnn) v a
-> ABT (F v a patternAnn) v (Term (F v a patternAnn) v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out -> ABT.Abs v
v Term (F v a patternAnn) v a
body) -> a
-> v -> Term (F v a patternAnn) v a -> Term (F v a patternAnn) v a
forall v a (f :: * -> *).
Ord v =>
a -> v -> Term f v a -> Term f v a
ABT.abs' a
loc v
v (Set v -> Term (F v a patternAnn) v a -> Term (F v a patternAnn) v a
go Set v
bound Term (F v a patternAnn) v a
body)
            (Term (F v a patternAnn) v a
-> ABT (F v a patternAnn) v (Term (F v a patternAnn) v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out -> ABT.Cycle Term (F v a patternAnn) v a
body) -> a -> Term (F v a patternAnn) v a -> Term (F v a patternAnn) v a
forall a (f :: * -> *) v. a -> Term f v a -> Term f v a
ABT.cycle' a
loc (Set v -> Term (F v a patternAnn) v a -> Term (F v a patternAnn) v a
go Set v
bound Term (F v a patternAnn) v a
body)
            Term (F v a patternAnn) v a
_ -> String -> Term (F v a patternAnn) v a
forall a. HasCallStack => String -> a
error String
"unpossible"

-- nicer pattern syntax

pattern Var' :: v -> ABT.Term f v a
pattern $mVar' :: forall {r} {v} {f :: * -> *} {a}.
Term f v a -> (v -> r) -> ((# #) -> r) -> r
Var' v <- ABT.Var' v

pattern Cycle' :: [v] -> f (ABT.Term f v a) -> ABT.Term f v a
pattern $mCycle' :: forall {r} {v} {f :: * -> *} {a}.
Term f v a -> ([v] -> f (Term f v a) -> r) -> ((# #) -> r) -> r
Cycle' xs t <- ABT.Cycle' xs t

pattern Abs' ::
  (Foldable f, Functor f, ABT.Var v) =>
  ABT.Subst f v a ->
  ABT.Term f v a
pattern $mAbs' :: forall {r} {f :: * -> *} {v} {a}.
(Foldable f, Functor f, Var v) =>
Term f v a -> (Subst f v a -> r) -> ((# #) -> r) -> r
Abs' subst <- ABT.Abs' subst

pattern Int' :: Int64 -> ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mInt' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Int64 -> r) -> ((# #) -> r) -> r
Int' n <- (ABT.out -> ABT.Tm (Int n))

pattern Nat' :: Word64 -> ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mNat' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Word64 -> r) -> ((# #) -> r) -> r
Nat' n <- (ABT.out -> ABT.Tm (Nat n))

pattern Float' :: Double -> ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mFloat' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Double -> r) -> ((# #) -> r) -> r
Float' n <- (ABT.out -> ABT.Tm (Float n))

pattern Boolean' :: Bool -> ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mBoolean' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Bool -> r) -> ((# #) -> r) -> r
Boolean' b <- (ABT.out -> ABT.Tm (Boolean b))

pattern Text' :: Text -> ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mText' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Text -> r) -> ((# #) -> r) -> r
Text' s <- (ABT.out -> ABT.Tm (Text s))

pattern Char' :: Char -> ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mChar' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Char -> r) -> ((# #) -> r) -> r
Char' c <- (ABT.out -> ABT.Tm (Char c))

pattern Blank' :: B.Blank typeAnn -> ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mBlank' :: forall {r} {typeAnn} {typeVar} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Blank typeAnn -> r) -> ((# #) -> r) -> r
Blank' b <- (ABT.out -> ABT.Tm (Blank b))

pattern Ref' :: Reference -> ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mRef' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Reference -> r) -> ((# #) -> r) -> r
Ref' r <- (ABT.out -> ABT.Tm (Ref r))

pattern TermLink' :: Referent -> ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mTermLink' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Referent -> r) -> ((# #) -> r) -> r
TermLink' r <- (ABT.out -> ABT.Tm (TermLink r))

pattern TypeLink' :: Reference -> ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mTypeLink' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Reference -> r) -> ((# #) -> r) -> r
TypeLink' r <- (ABT.out -> ABT.Tm (TypeLink r))

pattern Builtin' :: Text -> ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mBuiltin' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Text -> r) -> ((# #) -> r) -> r
Builtin' r <- (ABT.out -> ABT.Tm (Ref (Builtin r)))

pattern App' ::
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mApp' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Term (F typeVar typeAnn patternAnn) v a
    -> Term (F typeVar typeAnn patternAnn) v a -> r)
-> ((# #) -> r)
-> r
App' f x <- (ABT.out -> ABT.Tm (App f x))

pattern Match' ::
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  [ MatchCase
      patternAnn
      (ABT.Term (F typeVar typeAnn patternAnn) v a)
  ] ->
  ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mMatch' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Term (F typeVar typeAnn patternAnn) v a
    -> [MatchCase patternAnn (Term (F typeVar typeAnn patternAnn) v a)]
    -> r)
-> ((# #) -> r)
-> r
Match' scrutinee branches <- (ABT.out -> ABT.Tm (Match scrutinee branches))

pattern Constructor' :: ConstructorReference -> ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mConstructor' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (ConstructorReference -> r) -> ((# #) -> r) -> r
Constructor' ref <- (ABT.out -> ABT.Tm (Constructor ref))

pattern Request' :: ConstructorReference -> ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mRequest' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (ConstructorReference -> r) -> ((# #) -> r) -> r
Request' ref <- (ABT.out -> ABT.Tm (Request ref))

pattern RequestOrCtor' :: ConstructorReference -> Term2 vt at ap v a
pattern $mRequestOrCtor' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (ConstructorReference -> r) -> ((# #) -> r) -> r
RequestOrCtor' ref <- (unReqOrCtor -> Just ref)

pattern If' ::
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mIf' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Term (F typeVar typeAnn patternAnn) v a
    -> Term (F typeVar typeAnn patternAnn) v a
    -> Term (F typeVar typeAnn patternAnn) v a
    -> r)
-> ((# #) -> r)
-> r
If' cond t f <- (ABT.out -> ABT.Tm (If cond t f))

pattern And' ::
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mAnd' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Term (F typeVar typeAnn patternAnn) v a
    -> Term (F typeVar typeAnn patternAnn) v a -> r)
-> ((# #) -> r)
-> r
And' x y <- (ABT.out -> ABT.Tm (And x y))

pattern Or' ::
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mOr' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Term (F typeVar typeAnn patternAnn) v a
    -> Term (F typeVar typeAnn patternAnn) v a -> r)
-> ((# #) -> r)
-> r
Or' x y <- (ABT.out -> ABT.Tm (Or x y))

pattern Handle' ::
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mHandle' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Term (F typeVar typeAnn patternAnn) v a
    -> Term (F typeVar typeAnn patternAnn) v a -> r)
-> ((# #) -> r)
-> r
Handle' h body <- (ABT.out -> ABT.Tm (Handle h body))

pattern Apps' :: Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
pattern $mApps' :: forall {r} {vt} {at} {ap} {v} {a}.
Term2 vt at ap v a
-> (Term2 vt at ap v a -> [Term2 vt at ap v a] -> r)
-> ((# #) -> r)
-> r
Apps' f args <- (unApps -> Just (f, args))

-- begin pretty-printer helper patterns
pattern Ands' :: [Term2 vt at ap v a] -> Term2 vt at ap v a -> Term2 vt at ap v a
pattern $mAnds' :: forall {r} {vt} {at} {ap} {v} {a}.
Term2 vt at ap v a
-> ([Term2 vt at ap v a] -> Term2 vt at ap v a -> r)
-> ((# #) -> r)
-> r
Ands' ands lastArg <- (unAnds -> Just (ands, lastArg))

pattern Ors' :: [Term2 vt at ap v a] -> Term2 vt at ap v a -> Term2 vt at ap v a
pattern $mOrs' :: forall {r} {vt} {at} {ap} {v} {a}.
Term2 vt at ap v a
-> ([Term2 vt at ap v a] -> Term2 vt at ap v a -> r)
-> ((# #) -> r)
-> r
Ors' ors lastArg <- (unOrs -> Just (ors, lastArg))

pattern AppsPred' ::
  Term2 vt at ap v a ->
  [Term2 vt at ap v a] ->
  (Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
pattern $mAppsPred' :: forall {r} {vt} {at} {ap} {v} {a}.
(Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> (Term2 vt at ap v a -> [Term2 vt at ap v a] -> r)
-> ((# #) -> r)
-> r
AppsPred' f args <- (unAppsPred -> Just (f, args))

pattern BinaryApp' ::
  Term2 vt at ap v a ->
  Term2 vt at ap v a ->
  Term2 vt at ap v a ->
  Term2 vt at ap v a

pattern BinaryApps' ::
  [(Term2 vt at ap v a, Term2 vt at ap v a)] ->
  Term2 vt at ap v a ->
  Term2 vt at ap v a

pattern $mBinaryApp' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Term (F typeVar typeAnn patternAnn) v a
    -> Term (F typeVar typeAnn patternAnn) v a
    -> Term (F typeVar typeAnn patternAnn) v a
    -> r)
-> ((# #) -> r)
-> r
BinaryApp' f arg1 arg2 <- (unBinaryApp -> Just (f, arg1, arg2))

pattern $mBinaryApps' :: forall {r} {vt} {at} {ap} {v} {a}.
Term2 vt at ap v a
-> ([(Term2 vt at ap v a, Term2 vt at ap v a)]
    -> Term2 vt at ap v a -> r)
-> ((# #) -> r)
-> r
BinaryApps' apps lastArg <- (unBinaryApps -> Just (apps, lastArg))

pattern BinaryAppsPred' ::
  [(Term2 vt at ap v a, Term2 vt at ap v a)] ->
  Term2 vt at ap v a ->
  (Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
pattern $mBinaryAppsPred' :: forall {r} {vt} {at} {ap} {v} {a}.
(Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> ([(Term2 vt at ap v a, Term2 vt at ap v a)]
    -> Term2 vt at ap v a -> r)
-> ((# #) -> r)
-> r
BinaryAppsPred' apps lastArg <- (unBinaryAppsPred -> Just (apps, lastArg))

pattern BinaryAppPred' ::
  Term2 vt at ap v a ->
  Term2 vt at ap v a ->
  Term2 vt at ap v a ->
  (Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
pattern $mBinaryAppPred' :: forall {r} {vt} {at} {ap} {v} {a}.
(Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> (Term2 vt at ap v a
    -> Term2 vt at ap v a -> Term2 vt at ap v a -> r)
-> ((# #) -> r)
-> r
BinaryAppPred' f arg1 arg2 <- (unBinaryAppPred -> Just (f, arg1, arg2))

pattern OverappliedBinaryAppPred' ::
  Term2 vt at ap v a ->
  Term2 vt at ap v a ->
  Term2 vt at ap v a ->
  [Term2 vt at ap v a] ->
  (Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
pattern $mOverappliedBinaryAppPred' :: forall {r} {vt} {at} {ap} {v} {a}.
(Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> (Term2 vt at ap v a
    -> Term2 vt at ap v a
    -> Term2 vt at ap v a
    -> [Term2 vt at ap v a]
    -> r)
-> ((# #) -> r)
-> r
OverappliedBinaryAppPred' f arg1 arg2 rest <-
  (unOverappliedBinaryAppPred -> Just (f, arg1, arg2, rest))

-- end pretty-printer helper patterns
pattern Ann' ::
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  Type typeVar typeAnn ->
  ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mAnn' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Term (F typeVar typeAnn patternAnn) v a
    -> Type typeVar typeAnn -> r)
-> ((# #) -> r)
-> r
Ann' x t <- (ABT.out -> ABT.Tm (Ann x t))

pattern List' ::
  Seq (ABT.Term (F typeVar typeAnn patternAnn) v a) ->
  ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mList' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Seq (Term (F typeVar typeAnn patternAnn) v a) -> r)
-> ((# #) -> r)
-> r
List' xs <- (ABT.out -> ABT.Tm (List xs))

pattern Lam' ::
  (ABT.Var v) =>
  ABT.Subst (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mLam' :: forall {r} {v} {typeVar} {typeAnn} {patternAnn} {a}.
Var v =>
Term (F typeVar typeAnn patternAnn) v a
-> (Subst (F typeVar typeAnn patternAnn) v a -> r)
-> ((# #) -> r)
-> r
Lam' subst <- ABT.Tm' (Lam (ABT.Abs' subst))

pattern Delay' :: (Var v) => Term2 vt at ap v a -> Term2 vt at ap v a
pattern $mDelay' :: forall {r} {v} {vt} {at} {ap} {a}.
Var v =>
Term2 vt at ap v a
-> (Term2 vt at ap v a -> r) -> ((# #) -> r) -> r
Delay' body <- (unDelay -> Just body)

unDelay :: (Var v) => Term2 vt at ap v a -> Maybe (Term2 vt at ap v a)
unDelay :: forall v vt at ap a.
Var v =>
Term2 vt at ap v a -> Maybe (Term2 vt at ap v a)
unDelay Term2 vt at ap v a
tm = case Term2 vt at ap v a -> ABT (F vt at ap) v (Term2 vt at ap v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out Term2 vt at ap v a
tm of
  ABT.Tm (Lam (ABT.Term Set v
_ a
_ (ABT.Abs v
v Term2 vt at ap v a
body)))
    | v -> Type
forall v. Var v => v -> Type
Var.typeOf v
v Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
Var.Delay Bool -> Bool -> Bool
|| v -> Type
forall v. Var v => v -> Type
Var.typeOf v
v Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Type
Var.User Text
"()" ->
        Term2 vt at ap v a -> Maybe (Term2 vt at ap v a)
forall a. a -> Maybe a
Just Term2 vt at ap v a
body
  ABT (F vt at ap) v (Term2 vt at ap v a)
_ -> Maybe (Term2 vt at ap v a)
forall a. Maybe a
Nothing

pattern LamNamed' ::
  v ->
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mLamNamed' :: forall {r} {v} {typeVar} {typeAnn} {patternAnn} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (v -> Term (F typeVar typeAnn patternAnn) v a -> r)
-> ((# #) -> r)
-> r
LamNamed' v body <- (ABT.out -> ABT.Tm (Lam (ABT.Term _ _ (ABT.Abs v body))))

pattern LamsNamed' :: [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
pattern $mLamsNamed' :: forall {r} {v} {vt} {at} {ap} {a}.
Term2 vt at ap v a
-> ([v] -> Term2 vt at ap v a -> r) -> ((# #) -> r) -> r
LamsNamed' vs body <- (unLams' -> Just (vs, body))

pattern LamsNamedOpt' :: [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
pattern $mLamsNamedOpt' :: forall {r} {v} {vt} {at} {ap} {a}.
Term2 vt at ap v a
-> ([v] -> Term2 vt at ap v a -> r) -> ((# #) -> r) -> r
LamsNamedOpt' vs body <- (unLamsOpt' -> Just (vs, body))

pattern LamsNamedPred' :: [v] -> Term2 vt at ap v a -> (Term2 vt at ap v a, v -> Bool)
pattern $mLamsNamedPred' :: forall {r} {v} {vt} {at} {ap} {a}.
(Term2 vt at ap v a, v -> Bool)
-> ([v] -> Term2 vt at ap v a -> r) -> ((# #) -> r) -> r
LamsNamedPred' vs body <- (unLamsPred' -> Just (vs, body))

pattern LamsNamedOrDelay' ::
  (Var v) =>
  [v] ->
  Term2 vt at ap v a ->
  Term2 vt at ap v a
pattern $mLamsNamedOrDelay' :: forall {r} {v} {vt} {at} {ap} {a}.
Var v =>
Term2 vt at ap v a
-> ([v] -> Term2 vt at ap v a -> r) -> ((# #) -> r) -> r
LamsNamedOrDelay' vs body <- (unLamsUntilDelay' -> Just (vs, body))

pattern Let1' ::
  (Var v) =>
  Term' vt v a ->
  ABT.Subst (F vt a a) v a ->
  Term' vt v a
pattern $mLet1' :: forall {r} {v} {vt} {a}.
Var v =>
Term' vt v a
-> (Term' vt v a -> Subst (F vt a a) v a -> r) -> ((# #) -> r) -> r
Let1' b subst <- (unLet1 -> Just (_, b, subst))

pattern Let1Top' ::
  (Var v) =>
  IsTop ->
  Term' vt v a ->
  ABT.Subst (F vt a a) v a ->
  Term' vt v a
pattern $mLet1Top' :: forall {r} {v} {vt} {a}.
Var v =>
Term' vt v a
-> (Bool -> Term' vt v a -> Subst (F vt a a) v a -> r)
-> ((# #) -> r)
-> r
Let1Top' top b subst <- (unLet1 -> Just (top, b, subst))

pattern Let1Named' ::
  v ->
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mLet1Named' :: forall {r} {v} {typeVar} {typeAnn} {patternAnn} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (v
    -> Term (F typeVar typeAnn patternAnn) v a
    -> Term (F typeVar typeAnn patternAnn) v a
    -> r)
-> ((# #) -> r)
-> r
Let1Named' v b e <- (ABT.Tm' (Let _ b (ABT.out -> ABT.Abs v e)))

pattern Let1NamedTop' ::
  IsTop ->
  v ->
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a ->
  ABT.Term (F typeVar typeAnn patternAnn) v a
pattern $mLet1NamedTop' :: forall {r} {v} {typeVar} {typeAnn} {patternAnn} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Bool
    -> v
    -> Term (F typeVar typeAnn patternAnn) v a
    -> Term (F typeVar typeAnn patternAnn) v a
    -> r)
-> ((# #) -> r)
-> r
Let1NamedTop' top v b e <- (ABT.Tm' (Let top b (ABT.out -> ABT.Abs v e)))

pattern Lets' ::
  [(IsTop, v, Term2 vt at ap v a)] ->
  Term2 vt at ap v a ->
  Term2 vt at ap v a
pattern $mLets' :: forall {r} {v} {vt} {at} {ap} {a}.
Term2 vt at ap v a
-> ([(Bool, v, Term2 vt at ap v a)] -> Term2 vt at ap v a -> r)
-> ((# #) -> r)
-> r
Lets' bs e <- (unLet -> Just (bs, e))

pattern LetRecNamed' ::
  [(v, Term2 vt at ap v a)] ->
  Term2 vt at ap v a ->
  Term2 vt at ap v a
pattern $mLetRecNamed' :: forall {r} {v} {vt} {at} {ap} {a}.
Term2 vt at ap v a
-> ([(v, Term2 vt at ap v a)] -> Term2 vt at ap v a -> r)
-> ((# #) -> r)
-> r
LetRecNamed' bs e <- (unLetRecNamed -> Just (_, bs, e))

pattern LetRecNamedTop' ::
  IsTop ->
  [(v, Term2 vt at ap v a)] ->
  Term2 vt at ap v a ->
  Term2 vt at ap v a
pattern $mLetRecNamedTop' :: forall {r} {v} {vt} {at} {ap} {a}.
Term2 vt at ap v a
-> (Bool -> [(v, Term2 vt at ap v a)] -> Term2 vt at ap v a -> r)
-> ((# #) -> r)
-> r
LetRecNamedTop' top bs e <- (unLetRecNamed -> Just (top, bs, e))

pattern LetRec' ::
  (Monad m, Var v) =>
  ((v -> m v) -> m ([(v, Term2 vt at ap v a)], Term2 vt at ap v a)) ->
  Term2 vt at ap v a
pattern $mLetRec' :: forall {r} {m :: * -> *} {v} {vt} {at} {ap} {a}.
(Monad m, Var v) =>
Term2 vt at ap v a
-> (((v -> m v)
     -> m ([(v, Term2 vt at ap v a)], Term2 vt at ap v a))
    -> r)
-> ((# #) -> r)
-> r
LetRec' subst <- (unLetRec -> Just (_, subst))

pattern LetRecTop' ::
  (Monad m, Var v) =>
  IsTop ->
  ( (v -> m v) ->
    m ([(v, Term2 vt at ap v a)], Term2 vt at ap v a)
  ) ->
  Term2 vt at ap v a
pattern $mLetRecTop' :: forall {r} {m :: * -> *} {v} {vt} {at} {ap} {a}.
(Monad m, Var v) =>
Term2 vt at ap v a
-> (Bool
    -> ((v -> m v)
        -> m ([(v, Term2 vt at ap v a)], Term2 vt at ap v a))
    -> r)
-> ((# #) -> r)
-> r
LetRecTop' top subst <- (unLetRec -> Just (top, subst))

pattern LetRecNamedAnnotated' :: a -> [((a, v), Term' vt v a)] -> Term' vt v a -> Term' vt v a
pattern $mLetRecNamedAnnotated' :: forall {r} {a} {v} {vt}.
Term' vt v a
-> (a -> [((a, v), Term' vt v a)] -> Term' vt v a -> r)
-> ((# #) -> r)
-> r
LetRecNamedAnnotated' ann bs e <- (unLetRecNamedAnnotated -> Just (_, ann, bs, e))

pattern LetRecNamedAnnotatedTop' ::
  IsTop ->
  a ->
  [((a, v), Term' vt v a)] ->
  Term' vt v a ->
  Term' vt v a
pattern $mLetRecNamedAnnotatedTop' :: forall {r} {a} {v} {vt}.
Term' vt v a
-> (Bool -> a -> [((a, v), Term' vt v a)] -> Term' vt v a -> r)
-> ((# #) -> r)
-> r
LetRecNamedAnnotatedTop' top ann bs e <-
  (unLetRecNamedAnnotated -> Just (top, ann, bs, e))

fresh :: (Var v) => Term0 v -> v -> v
fresh :: forall v. Var v => Term0 v -> v -> v
fresh = Term (F v () ()) v () -> v -> v
forall v (f :: * -> *) a. Var v => Term f v a -> v -> v
ABT.fresh

-- some smart constructors

var :: a -> v -> Term2 vt at ap v a
var :: forall a v vt at ap. a -> v -> Term2 vt at ap v a
var = a -> v -> Term (F vt at ap) v a
forall a v (f :: * -> *). a -> v -> Term f v a
ABT.annotatedVar

var' :: (Var v) => Text -> Term0' vt v
var' :: forall v vt. Var v => Text -> Term0' vt v
var' = () -> v -> Term2 vt () () v ()
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var () (v -> Term2 vt () () v ())
-> (Text -> v) -> Text -> Term2 vt () () v ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> v
forall v. Var v => Text -> v
Var.named

ref :: (Ord v) => a -> Reference -> Term2 vt at ap v a
ref :: forall v a vt at ap. Ord v => a -> Reference -> Term2 vt at ap v a
ref a
a Reference
r = a -> F vt at ap (Term (F vt at ap) v a) -> Term (F vt at ap) v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Reference -> F vt at ap (Term (F vt at ap) v a)
forall typeVar typeAnn patternAnn a.
Reference -> F typeVar typeAnn patternAnn a
Ref Reference
r)

pattern Referent' :: Referent -> Term2 vt at ap v a
pattern $mReferent' :: forall {r} {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> (Referent -> r) -> ((# #) -> r) -> r
Referent' r <- (unReferent -> Just r)

unReferent :: Term2 vt at ap v a -> Maybe Referent
unReferent :: forall vt at ap v a. Term2 vt at ap v a -> Maybe Referent
unReferent (Ref' Reference
r) = Referent -> Maybe Referent
forall a. a -> Maybe a
Just (Referent -> Maybe Referent) -> Referent -> Maybe Referent
forall a b. (a -> b) -> a -> b
$ Reference -> Referent
Referent.Ref Reference
r
unReferent (Constructor' ConstructorReference
r) = Referent -> Maybe Referent
forall a. a -> Maybe a
Just (Referent -> Maybe Referent) -> Referent -> Maybe Referent
forall a b. (a -> b) -> a -> b
$ ConstructorReference -> ConstructorType -> Referent
Referent.Con ConstructorReference
r ConstructorType
CT.Data
unReferent (Request' ConstructorReference
r) = Referent -> Maybe Referent
forall a. a -> Maybe a
Just (Referent -> Maybe Referent) -> Referent -> Maybe Referent
forall a b. (a -> b) -> a -> b
$ ConstructorReference -> ConstructorType -> Referent
Referent.Con ConstructorReference
r ConstructorType
CT.Effect
unReferent Term (F vt at ap) v a
_ = Maybe Referent
forall a. Maybe a
Nothing

refId :: (Ord v) => a -> Reference.Id -> Term2 vt at ap v a
refId :: forall v a vt at ap. Ord v => a -> Id -> Term2 vt at ap v a
refId a
a = 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 a
a (Reference -> Term2 vt at ap v a)
-> (Id -> Reference) -> Id -> Term2 vt at ap v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Reference
forall h t. Id' h -> Reference' t h
Reference.DerivedId

termLink :: (Ord v) => a -> Referent -> Term2 vt at ap v a
termLink :: forall v a vt at ap. Ord v => a -> Referent -> Term2 vt at ap v a
termLink a
a Referent
r = a -> F vt at ap (Term (F vt at ap) v a) -> Term (F vt at ap) v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Referent -> F vt at ap (Term (F vt at ap) v a)
forall typeVar typeAnn patternAnn a.
Referent -> F typeVar typeAnn patternAnn a
TermLink Referent
r)

typeLink :: (Ord v) => a -> Reference -> Term2 vt at ap v a
typeLink :: forall v a vt at ap. Ord v => a -> Reference -> Term2 vt at ap v a
typeLink a
a Reference
r = a -> F vt at ap (Term (F vt at ap) v a) -> Term (F vt at ap) v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Reference -> F vt at ap (Term (F vt at ap) v a)
forall typeVar typeAnn patternAnn a.
Reference -> F typeVar typeAnn patternAnn a
TypeLink Reference
r)

builtin :: (Ord v) => a -> Text -> Term2 vt at ap v a
builtin :: forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin a
a Text
n = 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 a
a (Text -> Reference
forall t h. t -> Reference' t h
Reference.Builtin Text
n)

float :: (Ord v) => a -> Double -> Term2 vt at ap v a
float :: forall v a vt at ap. Ord v => a -> Double -> Term2 vt at ap v a
float a
a Double
d = a -> F vt at ap (Term (F vt at ap) v a) -> Term (F vt at ap) v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Double -> F vt at ap (Term (F vt at ap) v a)
forall typeVar typeAnn patternAnn a.
Double -> F typeVar typeAnn patternAnn a
Float Double
d)

boolean :: (Ord v) => a -> Bool -> Term2 vt at ap v a
boolean :: forall v a vt at ap. Ord v => a -> Bool -> Term2 vt at ap v a
boolean a
a Bool
b = a -> F vt at ap (Term (F vt at ap) v a) -> Term (F vt at ap) v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Bool -> F vt at ap (Term (F vt at ap) v a)
forall typeVar typeAnn patternAnn a.
Bool -> F typeVar typeAnn patternAnn a
Boolean Bool
b)

int :: (Ord v) => a -> Int64 -> Term2 vt at ap v a
int :: forall v a vt at ap. Ord v => a -> Int64 -> Term2 vt at ap v a
int a
a Int64
d = a -> F vt at ap (Term (F vt at ap) v a) -> Term (F vt at ap) v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Int64 -> F vt at ap (Term (F vt at ap) v a)
forall typeVar typeAnn patternAnn a.
Int64 -> F typeVar typeAnn patternAnn a
Int Int64
d)

nat :: (Ord v) => a -> Word64 -> Term2 vt at ap v a
nat :: forall v a vt at ap. Ord v => a -> Word64 -> Term2 vt at ap v a
nat a
a Word64
d = a -> F vt at ap (Term (F vt at ap) v a) -> Term (F vt at ap) v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Word64 -> F vt at ap (Term (F vt at ap) v a)
forall typeVar typeAnn patternAnn a.
Word64 -> F typeVar typeAnn patternAnn a
Nat Word64
d)

text :: (Ord v) => a -> Text -> Term2 vt at ap v a
text :: forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
text a
a = a -> F vt at ap (Term (F vt at ap) v a) -> Term (F vt at ap) v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (F vt at ap (Term (F vt at ap) v a) -> Term (F vt at ap) v a)
-> (Text -> F vt at ap (Term (F vt at ap) v a))
-> Text
-> Term (F vt at ap) v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> F vt at ap (Term (F vt at ap) v a)
forall typeVar typeAnn patternAnn a.
Text -> F typeVar typeAnn patternAnn a
Text

char :: (Ord v) => a -> Char -> Term2 vt at ap v a
char :: forall v a vt at ap. Ord v => a -> Char -> Term2 vt at ap v a
char a
a = a -> F vt at ap (Term (F vt at ap) v a) -> Term (F vt at ap) v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (F vt at ap (Term (F vt at ap) v a) -> Term (F vt at ap) v a)
-> (Char -> F vt at ap (Term (F vt at ap) v a))
-> Char
-> Term (F vt at ap) v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> F vt at ap (Term (F vt at ap) v a)
forall typeVar typeAnn patternAnn a.
Char -> F typeVar typeAnn patternAnn a
Char

watch :: (Var v, Semigroup a) => a -> String -> Term v a -> Term v a
watch :: forall v a.
(Var v, Semigroup a) =>
a -> String -> Term v a -> Term v a
watch a
a String
note Term v a
e =
  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 -> Text -> Term v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin a
a Text
"Debug.watch") [a -> Text -> Term v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
text a
a (String -> Text
Text.pack String
note), Term v a
e]

watchMaybe :: (Var v, Semigroup a) => Maybe String -> Term v a -> Term v a
watchMaybe :: forall v a.
(Var v, Semigroup a) =>
Maybe String -> Term v a -> Term v a
watchMaybe Maybe String
Nothing Term v a
e = Term v a
e
watchMaybe (Just String
note) Term v a
e = a -> String -> Term v a -> Term v a
forall v a.
(Var v, Semigroup a) =>
a -> String -> Term v a -> Term v a
watch (Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
e) String
note Term v a
e

blank :: (Ord v) => a -> Term2 vt at ap v a
blank :: forall v a vt at ap. Ord v => a -> Term2 vt at ap v a
blank a
a = a -> F vt at ap (Term (F vt at ap) v a) -> Term (F vt at ap) v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Blank at -> F vt at ap (Term (F vt at ap) v a)
forall typeVar typeAnn patternAnn a.
Blank typeAnn -> F typeVar typeAnn patternAnn a
Blank Blank at
forall loc. Blank loc
B.Blank)

placeholder :: (Ord v) => a -> String -> Term2 vt a ap v a
placeholder :: forall v a vt ap. Ord v => a -> String -> Term2 vt a ap v a
placeholder a
a String
s = a -> F vt a ap (Term (F vt a ap) v a) -> Term (F vt a ap) v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (F vt a ap (Term (F vt a ap) v a) -> Term (F vt a ap) v a)
-> (Blank a -> F vt a ap (Term (F vt a ap) v a))
-> Blank a
-> Term (F vt a ap) v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blank a -> F vt a ap (Term (F vt a ap) v a)
forall typeVar typeAnn patternAnn a.
Blank typeAnn -> F typeVar typeAnn patternAnn a
Blank (Blank a -> Term (F vt a ap) v a)
-> Blank a -> Term (F vt a ap) v a
forall a b. (a -> b) -> a -> b
$ Recorded a -> Blank a
forall loc. Recorded loc -> Blank loc
B.Recorded (a -> String -> Recorded a
forall loc. loc -> String -> Recorded loc
B.Placeholder a
a String
s)

resolve :: (Ord v) => at -> ab -> String -> Term2 vt ab ap v at
resolve :: forall v at ab vt ap.
Ord v =>
at -> ab -> String -> Term2 vt ab ap v at
resolve at
at ab
ab String
s = at -> F vt ab ap (Term (F vt ab ap) v at) -> Term (F vt ab ap) v at
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' at
at (F vt ab ap (Term (F vt ab ap) v at) -> Term (F vt ab ap) v at)
-> (Blank ab -> F vt ab ap (Term (F vt ab ap) v at))
-> Blank ab
-> Term (F vt ab ap) v at
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blank ab -> F vt ab ap (Term (F vt ab ap) v at)
forall typeVar typeAnn patternAnn a.
Blank typeAnn -> F typeVar typeAnn patternAnn a
Blank (Blank ab -> Term (F vt ab ap) v at)
-> Blank ab -> Term (F vt ab ap) v at
forall a b. (a -> b) -> a -> b
$ Recorded ab -> Blank ab
forall loc. Recorded loc -> Blank loc
B.Recorded (ab -> String -> Recorded ab
forall loc. loc -> String -> Recorded loc
B.Resolve ab
ab String
s)

missingResult :: (Ord v) => at -> ab -> Term2 vt ab ap v at
missingResult :: forall v at ab vt ap. Ord v => at -> ab -> Term2 vt ab ap v at
missingResult at
at ab
ab = at -> F vt ab ap (Term (F vt ab ap) v at) -> Term (F vt ab ap) v at
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' at
at (F vt ab ap (Term (F vt ab ap) v at) -> Term (F vt ab ap) v at)
-> (Blank ab -> F vt ab ap (Term (F vt ab ap) v at))
-> Blank ab
-> Term (F vt ab ap) v at
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blank ab -> F vt ab ap (Term (F vt ab ap) v at)
forall typeVar typeAnn patternAnn a.
Blank typeAnn -> F typeVar typeAnn patternAnn a
Blank (Blank ab -> Term (F vt ab ap) v at)
-> Blank ab -> Term (F vt ab ap) v at
forall a b. (a -> b) -> a -> b
$ Recorded ab -> Blank ab
forall loc. Recorded loc -> Blank loc
B.Recorded (ab -> Recorded ab
forall loc. loc -> Recorded loc
B.MissingResultPlaceholder ab
ab)

constructor :: (Ord v) => a -> ConstructorReference -> Term2 vt at ap v a
constructor :: forall v a vt at ap.
Ord v =>
a -> ConstructorReference -> Term2 vt at ap v a
constructor a
a ConstructorReference
ref = a -> F vt at ap (Term (F vt at ap) v a) -> Term (F vt at ap) v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (ConstructorReference -> F vt at ap (Term (F vt at ap) v a)
forall typeVar typeAnn patternAnn a.
ConstructorReference -> F typeVar typeAnn patternAnn a
Constructor ConstructorReference
ref)

request :: (Ord v) => a -> ConstructorReference -> Term2 vt at ap v a
request :: forall v a vt at ap.
Ord v =>
a -> ConstructorReference -> Term2 vt at ap v a
request a
a ConstructorReference
ref = a -> F vt at ap (Term (F vt at ap) v a) -> Term (F vt at ap) v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (ConstructorReference -> F vt at ap (Term (F vt at ap) v a)
forall typeVar typeAnn patternAnn a.
ConstructorReference -> F typeVar typeAnn patternAnn a
Request ConstructorReference
ref)

-- todo: delete and rename app' to app
app_ :: (Ord v) => Term0' vt v -> Term0' vt v -> Term0' vt v
app_ :: forall v vt. Ord v => Term0' vt v -> Term0' vt v -> Term0' vt v
app_ Term0' vt v
f Term0' vt v
arg = F vt () () (Term0' vt v) -> Term0' vt v
forall (f :: * -> *) v.
(Foldable f, Ord v) =>
f (Term f v ()) -> Term f v ()
ABT.tm (Term0' vt v -> Term0' vt v -> F vt () () (Term0' vt v)
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
App Term0' vt v
f Term0' vt v
arg)

app :: (Ord v) => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
app :: 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
app a
a Term2 vt at ap v a
f Term2 vt at ap v a
arg = a -> F vt at ap (Term2 vt at ap v a) -> Term2 vt at ap v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Term2 vt at ap v a
-> Term2 vt at ap v a -> F vt at ap (Term2 vt at ap v a)
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
App Term2 vt at ap v a
f Term2 vt at ap v a
arg)

match :: (Ord v) => a -> Term2 vt at a v a -> [MatchCase a (Term2 vt at a v a)] -> Term2 vt at a v a
match :: 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 Term2 vt at a v a
scrutinee [MatchCase a (Term2 vt at a v a)]
branches = a -> F vt at a (Term2 vt at a v a) -> Term2 vt at a v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Term2 vt at a v a
-> [MatchCase a (Term2 vt at a v a)]
-> F vt at a (Term2 vt at a v a)
forall typeVar typeAnn patternAnn a.
a -> [MatchCase patternAnn a] -> F typeVar typeAnn patternAnn a
Match Term2 vt at a v a
scrutinee [MatchCase a (Term2 vt at a v a)]
branches)

handle :: (Ord v) => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
handle :: 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 a
a Term2 vt at ap v a
h Term2 vt at ap v a
block = a -> F vt at ap (Term2 vt at ap v a) -> Term2 vt at ap v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Term2 vt at ap v a
-> Term2 vt at ap v a -> F vt at ap (Term2 vt at ap v a)
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
Handle Term2 vt at ap v a
h Term2 vt at ap v a
block)

and :: (Ord v) => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
and :: 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
and a
a Term2 vt at ap v a
x Term2 vt at ap v a
y = a -> F vt at ap (Term2 vt at ap v a) -> Term2 vt at ap v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Term2 vt at ap v a
-> Term2 vt at ap v a -> F vt at ap (Term2 vt at ap v a)
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
And Term2 vt at ap v a
x Term2 vt at ap v a
y)

or :: (Ord v) => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
or :: 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
or a
a Term2 vt at ap v a
x Term2 vt at ap v a
y = a -> F vt at ap (Term2 vt at ap v a) -> Term2 vt at ap v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Term2 vt at ap v a
-> Term2 vt at ap v a -> F vt at ap (Term2 vt at ap v a)
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
Or Term2 vt at ap v a
x Term2 vt at ap v a
y)

list :: (Ord v) => a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
list :: forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
list a
a [Term2 vt at ap v a]
es = a -> Seq (Term2 vt at ap v a) -> Term2 vt at ap v a
forall v a vt at ap.
Ord v =>
a -> Seq (Term2 vt at ap v a) -> Term2 vt at ap v a
list' a
a ([Term2 vt at ap v a] -> Seq (Term2 vt at ap v a)
forall a. [a] -> Seq a
Sequence.fromList [Term2 vt at ap v a]
es)

list' :: (Ord v) => a -> Seq (Term2 vt at ap v a) -> Term2 vt at ap v a
list' :: forall v a vt at ap.
Ord v =>
a -> Seq (Term2 vt at ap v a) -> Term2 vt at ap v a
list' a
a Seq (Term2 vt at ap v a)
es = a -> F vt at ap (Term2 vt at ap v a) -> Term2 vt at ap v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Seq (Term2 vt at ap v a) -> F vt at ap (Term2 vt at ap v a)
forall typeVar typeAnn patternAnn a.
Seq a -> F typeVar typeAnn patternAnn a
List Seq (Term2 vt at ap v a)
es)

apps ::
  (Ord v) =>
  Term2 vt at ap v a ->
  [(a, Term2 vt at ap v a)] ->
  Term2 vt at ap v a
apps :: 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 = (Term2 vt at ap v a
 -> (a, Term2 vt at ap v a) -> Term2 vt at ap v a)
-> Term2 vt at ap v a
-> [(a, Term2 vt at ap v a)]
-> Term2 vt at ap v a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Term2 vt at ap v a
f (a
a, Term2 vt at ap v a
t) -> a -> 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 =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
app a
a Term2 vt at ap v a
f Term2 vt at ap v a
t)

apps' ::
  (Ord v, Semigroup a) =>
  Term2 vt at ap v a ->
  [Term2 vt at ap v a] ->
  Term2 vt at ap v a
apps' :: 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' = (Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a)
-> Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Term2 vt at ap v a
f Term2 vt at ap v a
t -> a -> 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 =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
app (Term2 vt at ap v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term2 vt at ap v a
f a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Term2 vt at ap v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term2 vt at ap v a
t) Term2 vt at ap v a
f Term2 vt at ap v a
t)

iff :: (Ord v) => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
iff :: 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
-> Term2 vt at ap v a
iff a
a Term2 vt at ap v a
cond Term2 vt at ap v a
t Term2 vt at ap v a
f = a -> F vt at ap (Term2 vt at ap v a) -> Term2 vt at ap v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Term2 vt at ap v a
-> Term2 vt at ap v a
-> Term2 vt at ap v a
-> F vt at ap (Term2 vt at ap v a)
forall typeVar typeAnn patternAnn a.
a -> a -> a -> F typeVar typeAnn patternAnn a
If Term2 vt at ap v a
cond Term2 vt at ap v a
t Term2 vt at ap v a
f)

ann_ :: (Ord v) => Term0' vt v -> Type vt () -> Term0' vt v
ann_ :: forall v vt. Ord v => Term0' vt v -> Type vt () -> Term0' vt v
ann_ Term0' vt v
e Type vt ()
t = F vt () () (Term0' vt v) -> Term0' vt v
forall (f :: * -> *) v.
(Foldable f, Ord v) =>
f (Term f v ()) -> Term f v ()
ABT.tm (Term0' vt v -> Type vt () -> F vt () () (Term0' vt v)
forall typeVar typeAnn patternAnn a.
a -> Type typeVar typeAnn -> F typeVar typeAnn patternAnn a
Ann Term0' vt v
e Type vt ()
t)

ann ::
  (Ord v) =>
  a ->
  Term2 vt at ap v a ->
  Type vt at ->
  Term2 vt at ap v a
ann :: 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 Term2 vt at ap v a
e Type vt at
t = a -> F vt at ap (Term2 vt at ap v a) -> Term2 vt at ap v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Term2 vt at ap v a -> Type vt at -> F vt at ap (Term2 vt at ap v a)
forall typeVar typeAnn patternAnn a.
a -> Type typeVar typeAnn -> F typeVar typeAnn patternAnn a
Ann Term2 vt at ap v a
e Type vt at
t)

-- | Add a lambda with a single argument.
lam ::
  (Ord v) =>
  -- | Annotation of the whole lambda
  a ->
  -- Annotation of just the arg binding
  (a, v) ->
  Term2 vt at ap v a ->
  Term2 vt at ap v a
lam :: forall v a vt at ap.
Ord v =>
a -> (a, v) -> Term2 vt at ap v a -> Term2 vt at ap v a
lam a
spanAnn (a
bindingAnn, v
v) Term2 vt at ap v a
body = a -> F vt at ap (Term2 vt at ap v a) -> Term2 vt at ap v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
spanAnn (Term2 vt at ap v a -> F vt at ap (Term2 vt at ap v a)
forall typeVar typeAnn patternAnn a.
a -> F typeVar typeAnn patternAnn a
Lam (a -> v -> Term2 vt at ap v a -> Term2 vt at ap v a
forall v a (f :: * -> *).
Ord v =>
a -> v -> Term f v a -> Term f v a
ABT.abs' a
bindingAnn v
v Term2 vt at ap v a
body))

-- | Add a lambda with a list of arguments.
lam' ::
  (Ord v) =>
  -- | Annotation of the whole lambda
  a ->
  [(a {- Annotation of the arg binding -}, v)] ->
  Term2 vt at ap v a ->
  Term2 vt at ap v a
lam' :: forall v a vt at ap.
Ord v =>
a -> [(a, v)] -> Term2 vt at ap v a -> Term2 vt at ap v a
lam' a
a [(a, v)]
vs Term2 vt at ap v a
body = ((a, v) -> Term2 vt at ap v a -> Term2 vt at ap v a)
-> Term2 vt at ap v a -> [(a, v)] -> Term2 vt at ap v a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> (a, v) -> Term2 vt at ap v a -> Term2 vt at ap v a
forall v a vt at ap.
Ord v =>
a -> (a, v) -> Term2 vt at ap v a -> Term2 vt at ap v a
lam a
a) Term2 vt at ap v a
body [(a, v)]
vs

-- | Only use this variant if you don't have source annotations for the binding arguments available.
lamWithoutBindingAnns ::
  (Ord v) =>
  a ->
  [v] ->
  Term2 vt at ap v a ->
  Term2 vt at ap v a
lamWithoutBindingAnns :: 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 vt at ap v a
body = a -> [(a, v)] -> Term2 vt at ap v a -> Term2 vt at ap v a
forall v a vt at ap.
Ord v =>
a -> [(a, v)] -> Term2 vt at ap v a -> Term2 vt at ap v a
lam' a
a ((a
a,) (v -> (a, v)) -> [v] -> [(a, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
vs) Term2 vt at ap v a
body

delay :: (Var v) => a -> Term2 vt at ap v a -> Term2 vt at ap v a
delay :: forall v a vt at ap.
Var v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a
delay a
a Term2 vt at ap v a
body =
  a -> F vt at ap (Term2 vt at ap v a) -> Term2 vt at ap v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
a (Term2 vt at ap v a -> F vt at ap (Term2 vt at ap v a)
forall typeVar typeAnn patternAnn a.
a -> F typeVar typeAnn patternAnn a
Lam (a -> v -> Term2 vt at ap v a -> Term2 vt at ap v a
forall v a (f :: * -> *).
Ord v =>
a -> v -> Term f v a -> Term f v a
ABT.abs' a
a (Set v -> v -> v
forall v. Var v => Set v -> v -> v
ABT.freshIn (Term2 vt at ap v a -> Set v
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars Term2 vt at ap v a
body) (Type -> v
forall v. Var v => Type -> v
Var.typed Type
Var.Delay)) Term2 vt at ap v a
body))

isLam :: Term2 vt at ap v a -> Bool
isLam :: forall vt at ap v a. Term2 vt at ap v a -> Bool
isLam Term2 vt at ap v a
t = Term2 vt at ap v a -> Int
forall vt at ap v a. Term2 vt at ap v a -> Int
arity Term2 vt at ap v a
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

arity :: Term2 vt at ap v a -> Int
arity :: forall vt at ap v a. Term2 vt at ap v a -> Int
arity (LamNamed' v
_ Term (F vt at ap) v a
body) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Term (F vt at ap) v a -> Int
forall vt at ap v a. Term2 vt at ap v a -> Int
arity Term (F vt at ap) v a
body
arity (Ann' Term (F vt at ap) v a
e Type vt at
_) = Term (F vt at ap) v a -> Int
forall vt at ap v a. Term2 vt at ap v a -> Int
arity Term (F vt at ap) v a
e
arity Term (F vt at ap) v a
_ = Int
0

unLetRecNamedAnnotated ::
  Term' vt v a ->
  Maybe
    (IsTop, a, [((a, v), Term' vt v a)], Term' vt v a)
unLetRecNamedAnnotated :: forall vt v a.
Term' vt v a
-> Maybe (Bool, a, [((a, v), Term' vt v a)], Term' vt v a)
unLetRecNamedAnnotated (ABT.CycleA' a
ann [(a, v)]
avs (ABT.Tm' (LetRec Bool
isTop [Term (F vt a a) v a]
bs Term (F vt a a) v a
e))) =
  (Bool, a, [((a, v), Term (F vt a a) v a)], Term (F vt a a) v a)
-> Maybe
     (Bool, a, [((a, v), Term (F vt a a) v a)], Term (F vt a a) v a)
forall a. a -> Maybe a
Just (Bool
isTop, a
ann, [(a, v)]
avs [(a, v)]
-> [Term (F vt a a) v a] -> [((a, v), Term (F vt a a) v a)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Term (F vt a a) v a]
bs, Term (F vt a a) v a
e)
unLetRecNamedAnnotated Term (F vt a a) v a
_ = Maybe
  (Bool, a, [((a, v), Term (F vt a a) v a)], Term (F vt a a) v a)
forall a. Maybe a
Nothing

letRec' ::
  (Ord v, Monoid a) =>
  Bool ->
  [(v, a, Term' vt v a)] ->
  Term' vt v a ->
  Term' vt v a
letRec' :: 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
isTop [(v, a, Term' vt v a)]
bindings Term' vt v a
body =
  Bool
-> a -> [((a, v), Term' vt v a)] -> Term' vt v a -> Term' vt v a
forall v vt a.
Ord v =>
Bool
-> a -> [((a, v), Term' vt v a)] -> Term' vt v a -> Term' vt v a
letRec
    Bool
isTop
    (((v, a, Term' vt v a) -> a) -> [(v, a, Term' vt v a)] -> a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Getting a (v, a, Term' vt v a) a -> (v, a, Term' vt v a) -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting a (v, a, Term' vt v a) a
forall s t a b. Field2 s t a b => Lens s t a b
Lens (v, a, Term' vt v a) (v, a, Term' vt v a) a a
_2) [(v, a, Term' vt v a)]
bindings a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Term' vt v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term' vt v a
body)
    [((a
a, v
v), Term' vt v a
b) | (v
v, a
a, Term' vt v a
b) <- [(v, a, Term' vt v a)]
bindings]
    Term' vt v a
body

-- Prepend a binding to form a (bigger) let rec. Useful when
-- building up a block incrementally using a right fold.
--
-- For example:
--   consLetRec (x = 42) "hi"
--   =>
--   let rec x = 42 in "hi"
--
--   consLetRec (x = 42) (let rec y = "hi" in (x,y))
--   =>
--   let rec x = 42; y = "hi" in (x,y)
consLetRec ::
  (Ord v, Semigroup a) =>
  Bool -> -- isTop parameter
  a -> -- annotation for overall let rec
  (a, v, Term' vt v a) -> -- the binding
  Term' vt v a -> -- the body
  Term' vt v a
consLetRec :: forall v a vt.
(Ord v, Semigroup a) =>
Bool -> a -> (a, v, Term' vt v a) -> Term' vt v a -> Term' vt v a
consLetRec Bool
isTop a
a (a
ab, v
vb, Term' vt v a
b) Term' vt v a
body = case Term' vt v a
body of
  LetRecNamedAnnotated' a
_ [((a, v), Term' vt v a)]
bs Term' vt v a
body -> Bool
-> a -> [((a, v), Term' vt v a)] -> Term' vt v a -> Term' vt v a
forall v vt a.
Ord v =>
Bool
-> a -> [((a, v), Term' vt v a)] -> Term' vt v a -> Term' vt v a
letRec Bool
isTop a
a (((a
ab, v
vb), Term' vt v a
b) ((a, v), Term' vt v a)
-> [((a, v), Term' vt v a)] -> [((a, v), Term' vt v a)]
forall a. a -> [a] -> [a]
: [((a, v), Term' vt v a)]
bs) Term' vt v a
body
  Term' vt v a
_ -> Bool
-> a -> [((a, v), Term' vt v a)] -> Term' vt v a -> Term' vt v a
forall v vt a.
Ord v =>
Bool
-> a -> [((a, v), Term' vt v a)] -> Term' vt v a -> Term' vt v a
letRec Bool
isTop a
a [((a
ab, v
vb), Term' vt v a
b)] Term' vt v a
body

letRec ::
  forall v vt a.
  (Ord v) =>
  Bool ->
  -- Annotation spanning the full let rec
  a ->
  [((a, v), Term' vt v a)] ->
  Term' vt v a ->
  Term' vt v a
letRec :: forall v vt a.
Ord v =>
Bool
-> a -> [((a, v), Term' vt v a)] -> Term' vt v a -> Term' vt v a
letRec Bool
_ a
_ [] Term' vt v a
e = Term' vt v a
e
letRec Bool
isTop a
blockAnn [((a, v), Term' vt v a)]
bindings Term' vt v a
e =
  a -> Term' vt v a -> Term' vt v a
forall a (f :: * -> *) v. a -> Term f v a -> Term f v a
ABT.cycle'
    a
blockAnn
    ((((a, v), Term' vt v a) -> Term' vt v a -> Term' vt v a)
-> Term' vt v a -> [((a, v), Term' vt v a)] -> Term' vt v a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a, v), Term' vt v a) -> Term' vt v a -> Term' vt v a
forall b (f :: * -> *). ((a, v), b) -> Term f v a -> Term f v a
addAbs Term' vt v a
body [((a, v), Term' vt v a)]
bindings)
  where
    addAbs :: ((a, v), b) -> ABT.Term f v a -> ABT.Term f v a
    addAbs :: forall b (f :: * -> *). ((a, v), b) -> Term f v a -> Term f v a
addAbs ((a
a, v
v), b
_b) Term f v a
t = a -> v -> Term f v a -> Term f 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 f v a
t
    body :: Term' vt v a
    body :: Term' vt v a
body = a -> F vt a a (Term' vt v a) -> Term' vt v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
blockAnn (Bool -> [Term' vt v a] -> Term' vt v a -> F vt a a (Term' vt v a)
forall typeVar typeAnn patternAnn a.
Bool -> [a] -> a -> F typeVar typeAnn patternAnn a
LetRec Bool
isTop ((((a, v), Term' vt v a) -> Term' vt v a)
-> [((a, v), Term' vt v a)] -> [Term' vt v a]
forall a b. (a -> b) -> [a] -> [b]
map ((a, v), Term' vt v a) -> Term' vt v a
forall a b. (a, b) -> b
snd [((a, v), Term' vt v a)]
bindings) Term' vt v a
e)

-- | Smart constructor for let rec blocks. Each binding in the block may
-- reference any other binding in the block in its body (including itself),
-- and the output expression may also reference any binding in the block.
letRec_ :: (Ord v) => IsTop -> [(v, Term0' vt v)] -> Term0' vt v -> Term0' vt v
letRec_ :: forall v vt.
Ord v =>
Bool -> [(v, Term0' vt v)] -> Term0' vt v -> Term0' vt v
letRec_ Bool
_ [] Term0' vt v
e = Term0' vt v
e
letRec_ Bool
isTop [(v, Term0' vt v)]
bindings Term0' vt v
e = Term0' vt v -> Term0' vt v
forall (f :: * -> *) v. Term f v () -> Term f v ()
ABT.cycle (((v, Term0' vt v) -> Term0' vt v -> Term0' vt v)
-> Term0' vt v -> [(v, Term0' vt v)] -> Term0' vt v
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (v -> Term0' vt v -> Term0' vt v
forall v (f :: * -> *). Ord v => v -> Term f v () -> Term f v ()
ABT.abs (v -> Term0' vt v -> Term0' vt v)
-> ((v, Term0' vt v) -> v)
-> (v, Term0' vt v)
-> Term0' vt v
-> Term0' vt v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v, Term0' vt v) -> v
forall a b. (a, b) -> a
fst) Term0' vt v
z [(v, Term0' vt v)]
bindings)
  where
    z :: Term0' vt v
z = F vt () () (Term0' vt v) -> Term0' vt v
forall (f :: * -> *) v.
(Foldable f, Ord v) =>
f (Term f v ()) -> Term f v ()
ABT.tm (Bool -> [Term0' vt v] -> Term0' vt v -> F vt () () (Term0' vt v)
forall typeVar typeAnn patternAnn a.
Bool -> [a] -> a -> F typeVar typeAnn patternAnn a
LetRec Bool
isTop (((v, Term0' vt v) -> Term0' vt v)
-> [(v, Term0' vt v)] -> [Term0' vt v]
forall a b. (a -> b) -> [a] -> [b]
map (v, Term0' vt v) -> Term0' vt v
forall a b. (a, b) -> b
snd [(v, Term0' vt v)]
bindings) Term0' vt v
e)

-- | Smart constructor for let blocks. Each binding in the block may
-- reference only previous bindings in the block, not including itself.
-- The output expression may reference any binding in the block.
-- todo: delete me
let1_ :: (Ord v) => IsTop -> [(v, Term0' vt v)] -> Term0' vt v -> Term0' vt v
let1_ :: forall v vt.
Ord v =>
Bool -> [(v, Term0' vt v)] -> Term0' vt v -> Term0' vt v
let1_ Bool
isTop [(v, Term0' vt v)]
bindings Term0' vt v
e = ((v, Term0' vt v) -> Term0' vt v -> Term0' vt v)
-> Term0' vt v -> [(v, Term0' vt v)] -> Term0' vt v
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (v, Term0' vt v) -> Term0' vt v -> Term0' vt v
f Term0' vt v
e [(v, Term0' vt v)]
bindings
  where
    f :: (v, Term0' vt v) -> Term0' vt v -> Term0' vt v
f (v
v, Term0' vt v
b) Term0' vt v
body = F vt () () (Term0' vt v) -> Term0' vt v
forall (f :: * -> *) v.
(Foldable f, Ord v) =>
f (Term f v ()) -> Term f v ()
ABT.tm (Bool -> Term0' vt v -> Term0' vt v -> F vt () () (Term0' vt v)
forall typeVar typeAnn patternAnn a.
Bool -> a -> a -> F typeVar typeAnn patternAnn a
Let Bool
isTop Term0' vt v
b (v -> Term0' vt v -> Term0' vt v
forall v (f :: * -> *). Ord v => v -> Term f v () -> Term f v ()
ABT.abs v
v Term0' vt v
body))

-- | annotations are applied to each nested Let expression
let1 ::
  (Ord v, Semigroup a) =>
  IsTop ->
  [((a, v), Term2 vt at ap v a)] ->
  Term2 vt at ap v a ->
  Term2 vt at ap v a
let1 :: forall v a vt at ap.
(Ord v, Semigroup a) =>
Bool
-> [((a, v), Term2 vt at ap v a)]
-> Term2 vt at ap v a
-> Term2 vt at ap v a
let1 Bool
isTop [((a, v), Term2 vt at ap v a)]
bindings Term2 vt at ap v a
e = (((a, v), Term2 vt at ap v a)
 -> Term2 vt at ap v a -> Term2 vt at ap v a)
-> Term2 vt at ap v a
-> [((a, v), Term2 vt at ap v a)]
-> Term2 vt at ap v a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a, v), Term2 vt at ap v a)
-> Term2 vt at ap v a -> Term2 vt at ap v a
f Term2 vt at ap v a
e [((a, v), Term2 vt at ap v a)]
bindings
  where
    f :: ((a, v), Term2 vt at ap v a)
-> Term2 vt at ap v a -> Term2 vt at ap v a
f ((a
ann, v
v), Term2 vt at ap v a
b) Term2 vt at ap v a
body = a -> F vt at ap (Term2 vt at ap v a) -> Term2 vt at ap v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' (a
ann a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Term2 vt at ap v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term2 vt at ap v a
body) (Bool
-> Term2 vt at ap v a
-> Term2 vt at ap v a
-> F vt at ap (Term2 vt at ap v a)
forall typeVar typeAnn patternAnn a.
Bool -> a -> a -> F typeVar typeAnn patternAnn a
Let Bool
isTop Term2 vt at ap v a
b (a -> v -> Term2 vt at ap v a -> Term2 vt at ap v a
forall v a (f :: * -> *).
Ord v =>
a -> v -> Term f v a -> Term f v a
ABT.abs' a
ann v
v Term2 vt at ap v a
body))

let1' ::
  (Semigroup a, Ord v) =>
  IsTop ->
  [(v, Term2 vt at ap v a)] ->
  Term2 vt at ap v a ->
  Term2 vt at ap v a
let1' :: 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
isTop [(v, Term2 vt at ap v a)]
bindings Term2 vt at ap v a
e = ((v, Term2 vt at ap v a)
 -> Term2 vt at ap v a -> Term2 vt at ap v a)
-> Term2 vt at ap v a
-> [(v, Term2 vt at ap v a)]
-> Term2 vt at ap v a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (v, Term2 vt at ap v a) -> Term2 vt at ap v a -> Term2 vt at ap v a
f Term2 vt at ap v a
e [(v, Term2 vt at ap v a)]
bindings
  where
    ann :: Term f v a -> a
ann = Term f v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation
    f :: (v, Term2 vt at ap v a) -> Term2 vt at ap v a -> Term2 vt at ap v a
f (v
v, Term2 vt at ap v a
b) Term2 vt at ap v a
body = a -> F vt at ap (Term2 vt at ap v a) -> Term2 vt at ap v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Term2 vt at ap v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term2 vt at ap v a
body) (Bool
-> Term2 vt at ap v a
-> Term2 vt at ap v a
-> F vt at ap (Term2 vt at ap v a)
forall typeVar typeAnn patternAnn a.
Bool -> a -> a -> F typeVar typeAnn patternAnn a
Let Bool
isTop Term2 vt at ap v a
b (a -> v -> Term2 vt at ap v a -> Term2 vt at ap v a
forall v a (f :: * -> *).
Ord v =>
a -> v -> Term f v a -> Term f v a
ABT.abs' (Term2 vt at ap v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term2 vt at ap v a
body) v
v Term2 vt at ap v a
body))
      where
        a :: a
a = Term2 vt at ap v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ann Term2 vt at ap v a
b a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Term2 vt at ap v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ann Term2 vt at ap v a
body

-- | Like 'let1', but for a single binding, avoiding the Semigroup constraint.
singleLet ::
  (Ord v) =>
  IsTop ->
  -- Annotation spanning the let-binding and its body
  a ->
  -- Annotation for just the binding, not the body it's used in.
  a ->
  (v, Term2 vt at ap v a) ->
  Term2 vt at ap v a ->
  Term2 vt at ap v a
singleLet :: forall v a vt at ap.
Ord v =>
Bool
-> a
-> a
-> (v, Term2 vt at ap v a)
-> Term2 vt at ap v a
-> Term2 vt at ap v a
singleLet Bool
isTop a
spanAnn a
absAnn (v
v, Term2 vt at ap v a
body) Term2 vt at ap v a
e = a -> F vt at ap (Term2 vt at ap v a) -> Term2 vt at ap v a
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm' a
spanAnn (Bool
-> Term2 vt at ap v a
-> Term2 vt at ap v a
-> F vt at ap (Term2 vt at ap v a)
forall typeVar typeAnn patternAnn a.
Bool -> a -> a -> F typeVar typeAnn patternAnn a
Let Bool
isTop Term2 vt at ap v a
body (a -> v -> Term2 vt at ap v a -> Term2 vt at ap v a
forall v a (f :: * -> *).
Ord v =>
a -> v -> Term f v a -> Term f v a
ABT.abs' a
absAnn v
v Term2 vt at ap v a
e))

-- let1' :: Var v => [(Text, Term0 vt v)] -> Term0 vt v -> Term0 vt v
-- let1' bs e = let1 [(ABT.v' name, b) | (name,b) <- bs ] e

unLet1 ::
  (Var v) =>
  Term' vt v a ->
  Maybe (IsTop, Term' vt v a, ABT.Subst (F vt a a) v a)
unLet1 :: forall v vt a.
Var v =>
Term' vt v a -> Maybe (Bool, Term' vt v a, Subst (F vt a a) v a)
unLet1 (ABT.Tm' (Let Bool
isTop Term (F vt a a) v a
b (ABT.Abs' Subst (F vt a a) v a
subst))) = (Bool, Term (F vt a a) v a, Subst (F vt a a) v a)
-> Maybe (Bool, Term (F vt a a) v a, Subst (F vt a a) v a)
forall a. a -> Maybe a
Just (Bool
isTop, Term (F vt a a) v a
b, Subst (F vt a a) v a
subst)
unLet1 Term (F vt a a) v a
_ = Maybe (Bool, Term (F vt a a) v a, Subst (F vt a a) v a)
forall a. Maybe a
Nothing

-- | Satisfies `unLet (let' bs e) == Just (bs, e)`
unLet ::
  Term2 vt at ap v a ->
  Maybe ([(IsTop, v, Term2 vt at ap v a)], Term2 vt at ap v a)
unLet :: forall vt at ap v a.
Term2 vt at ap v a
-> Maybe ([(Bool, v, Term2 vt at ap v a)], Term2 vt at ap v a)
unLet Term2 vt at ap v a
t = ([(Bool, v, Term2 vt at ap v a)], Term2 vt at ap v a)
-> Maybe ([(Bool, v, Term2 vt at ap v a)], Term2 vt at ap v a)
forall {a} {b}. ([a], b) -> Maybe ([a], b)
fixup (Term2 vt at ap v a
-> ([(Bool, v, Term2 vt at ap v a)], Term2 vt at ap v a)
forall {typeVar} {typeAnn} {patternAnn} {b} {a}.
Term (F typeVar typeAnn patternAnn) b a
-> ([(Bool, b, Term (F typeVar typeAnn patternAnn) b a)],
    Term (F typeVar typeAnn patternAnn) b a)
go Term2 vt at ap v a
t)
  where
    go :: Term (F typeVar typeAnn patternAnn) b a
-> ([(Bool, b, Term (F typeVar typeAnn patternAnn) b a)],
    Term (F typeVar typeAnn patternAnn) b a)
go (ABT.Tm' (Let Bool
isTop Term (F typeVar typeAnn patternAnn) b a
b (Term (F typeVar typeAnn patternAnn) b a
-> ABT
     (F typeVar typeAnn patternAnn)
     b
     (Term (F typeVar typeAnn patternAnn) b a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out -> ABT.Abs b
v Term (F typeVar typeAnn patternAnn) b a
t))) = case Term (F typeVar typeAnn patternAnn) b a
-> ([(Bool, b, Term (F typeVar typeAnn patternAnn) b a)],
    Term (F typeVar typeAnn patternAnn) b a)
go Term (F typeVar typeAnn patternAnn) b a
t of
      ([(Bool, b, Term (F typeVar typeAnn patternAnn) b a)]
env, Term (F typeVar typeAnn patternAnn) b a
t) -> ((Bool
isTop, b
v, Term (F typeVar typeAnn patternAnn) b a
b) (Bool, b, Term (F typeVar typeAnn patternAnn) b a)
-> [(Bool, b, Term (F typeVar typeAnn patternAnn) b a)]
-> [(Bool, b, Term (F typeVar typeAnn patternAnn) b a)]
forall a. a -> [a] -> [a]
: [(Bool, b, Term (F typeVar typeAnn patternAnn) b a)]
env, Term (F typeVar typeAnn patternAnn) b a
t)
    go Term (F typeVar typeAnn patternAnn) b a
t = ([], Term (F typeVar typeAnn patternAnn) b a
t)
    fixup :: ([a], b) -> Maybe ([a], b)
fixup ([], b
_) = Maybe ([a], b)
forall a. Maybe a
Nothing
    fixup ([a], b)
bst = ([a], b) -> Maybe ([a], b)
forall a. a -> Maybe a
Just ([a], b)
bst

-- | Satisfies `unLetRec (letRec bs e) == Just (bs, e)`
unLetRecNamed ::
  Term2 vt at ap v a ->
  Maybe
    ( IsTop,
      [(v, Term2 vt at ap v a)],
      Term2 vt at ap v a
    )
unLetRecNamed :: forall vt at ap v a.
Term2 vt at ap v a
-> Maybe (Bool, [(v, Term2 vt at ap v a)], Term2 vt at ap v a)
unLetRecNamed (ABT.Cycle' [v]
vs (LetRec Bool
isTop [Term (F vt at ap) v a]
bs Term (F vt at ap) v a
e))
  | [v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
vs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Term (F vt at ap) v a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Term (F vt at ap) v a]
bs = (Bool, [(v, Term (F vt at ap) v a)], Term (F vt at ap) v a)
-> Maybe
     (Bool, [(v, Term (F vt at ap) v a)], Term (F vt at ap) v a)
forall a. a -> Maybe a
Just (Bool
isTop, [v] -> [Term (F vt at ap) v a] -> [(v, Term (F vt at ap) v a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
vs [Term (F vt at ap) v a]
bs, Term (F vt at ap) v a
e)
unLetRecNamed Term (F vt at ap) v a
_ = Maybe (Bool, [(v, Term (F vt at ap) v a)], Term (F vt at ap) v a)
forall a. Maybe a
Nothing

unLetRec ::
  (Monad m, Var v) =>
  Term2 vt at ap v a ->
  Maybe
    ( IsTop,
      (v -> m v) ->
      m
        ( [(v, Term2 vt at ap v a)],
          Term2 vt at ap v a
        )
    )
unLetRec :: forall (m :: * -> *) v vt at ap a.
(Monad m, Var v) =>
Term2 vt at ap v a
-> Maybe
     (Bool,
      (v -> m v) -> m ([(v, Term2 vt at ap v a)], Term2 vt at ap v a))
unLetRec (Term2 vt at ap v a
-> Maybe (Bool, [(v, Term2 vt at ap v a)], Term2 vt at ap v a)
forall vt at ap v a.
Term2 vt at ap v a
-> Maybe (Bool, [(v, Term2 vt at ap v a)], Term2 vt at ap v a)
unLetRecNamed -> Just (Bool
isTop, [(v, Term2 vt at ap v a)]
bs, Term2 vt at ap v a
e)) =
  (Bool,
 (v -> m v) -> m ([(v, Term2 vt at ap v a)], Term2 vt at ap v a))
-> Maybe
     (Bool,
      (v -> m v) -> m ([(v, Term2 vt at ap v a)], Term2 vt at ap v a))
forall a. a -> Maybe a
Just
    ( Bool
isTop,
      \v -> m v
freshen -> do
        [v]
vs <- [m v] -> m [v]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [v -> m v
freshen v
v | (v
v, Term2 vt at ap v a
_) <- [(v, Term2 vt at ap v a)]
bs]
        let sub :: Term2 vt at ap v a -> Term2 vt at ap v a
sub = [(v, Term (F vt at ap) v ())]
-> Term2 vt at ap v a -> Term2 vt at ap v a
forall (f :: * -> *) v b a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v b)] -> Term f v a -> Term f v a
ABT.substsInheritAnnotation (((v, Term2 vt at ap v a) -> v) -> [(v, Term2 vt at ap v a)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (v, Term2 vt at ap v a) -> v
forall a b. (a, b) -> a
fst [(v, Term2 vt at ap v a)]
bs [v] -> [Term (F vt at ap) v ()] -> [(v, Term (F vt at ap) v ())]
forall a b. [a] -> [b] -> [(a, b)]
`zip` (v -> Term (F vt at ap) v ()) -> [v] -> [Term (F vt at ap) v ()]
forall a b. (a -> b) -> [a] -> [b]
map v -> Term (F vt at ap) v ()
forall v (f :: * -> *). v -> Term f v ()
ABT.var [v]
vs)
        ([(v, Term2 vt at ap v a)], Term2 vt at ap v a)
-> m ([(v, Term2 vt at ap v a)], Term2 vt at ap v a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([v]
vs [v] -> [Term2 vt at ap v a] -> [(v, Term2 vt at ap v a)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Term2 vt at ap v a -> Term2 vt at ap v a
sub Term2 vt at ap v a
b | (v
_, Term2 vt at ap v a
b) <- [(v, Term2 vt at ap v a)]
bs], Term2 vt at ap v a -> Term2 vt at ap v a
sub Term2 vt at ap v a
e)
    )
unLetRec Term2 vt at ap v a
_ = Maybe
  (Bool,
   (v -> m v) -> m ([(v, Term2 vt at ap v a)], Term2 vt at ap v a))
forall a. Maybe a
Nothing

unAnds ::
  Term2 vt at ap v a ->
  Maybe
    ( [Term2 vt at ap v a],
      Term2 vt at ap v a
    )
unAnds :: forall vt at ap v a.
Term2 vt at ap v a
-> Maybe ([Term2 vt at ap v a], Term2 vt at ap v a)
unAnds Term2 vt at ap v a
t = case Term2 vt at ap v a
t of
  And' Term2 vt at ap v a
i Term2 vt at ap v a
o -> case Term2 vt at ap v a
-> Maybe ([Term2 vt at ap v a], Term2 vt at ap v a)
forall vt at ap v a.
Term2 vt at ap v a
-> Maybe ([Term2 vt at ap v a], Term2 vt at ap v a)
unAnds Term2 vt at ap v a
i of
    Just ([Term2 vt at ap v a]
as, Term2 vt at ap v a
xLast) -> ([Term2 vt at ap v a], Term2 vt at ap v a)
-> Maybe ([Term2 vt at ap v a], Term2 vt at ap v a)
forall a. a -> Maybe a
Just (Term2 vt at ap v a
xLast Term2 vt at ap v a -> [Term2 vt at ap v a] -> [Term2 vt at ap v a]
forall a. a -> [a] -> [a]
: [Term2 vt at ap v a]
as, Term2 vt at ap v a
o)
    Maybe ([Term2 vt at ap v a], Term2 vt at ap v a)
Nothing -> ([Term2 vt at ap v a], Term2 vt at ap v a)
-> Maybe ([Term2 vt at ap v a], Term2 vt at ap v a)
forall a. a -> Maybe a
Just ([Term2 vt at ap v a
i], Term2 vt at ap v a
o)
  Term2 vt at ap v a
_ -> Maybe ([Term2 vt at ap v a], Term2 vt at ap v a)
forall a. Maybe a
Nothing

unOrs ::
  Term2 vt at ap v a ->
  Maybe
    ( [Term2 vt at ap v a],
      Term2 vt at ap v a
    )
unOrs :: forall vt at ap v a.
Term2 vt at ap v a
-> Maybe ([Term2 vt at ap v a], Term2 vt at ap v a)
unOrs Term2 vt at ap v a
t = case Term2 vt at ap v a
t of
  Or' Term2 vt at ap v a
i Term2 vt at ap v a
o -> case Term2 vt at ap v a
-> Maybe ([Term2 vt at ap v a], Term2 vt at ap v a)
forall vt at ap v a.
Term2 vt at ap v a
-> Maybe ([Term2 vt at ap v a], Term2 vt at ap v a)
unOrs Term2 vt at ap v a
i of
    Just ([Term2 vt at ap v a]
as, Term2 vt at ap v a
xLast) -> ([Term2 vt at ap v a], Term2 vt at ap v a)
-> Maybe ([Term2 vt at ap v a], Term2 vt at ap v a)
forall a. a -> Maybe a
Just (Term2 vt at ap v a
xLast Term2 vt at ap v a -> [Term2 vt at ap v a] -> [Term2 vt at ap v a]
forall a. a -> [a] -> [a]
: [Term2 vt at ap v a]
as, Term2 vt at ap v a
o)
    Maybe ([Term2 vt at ap v a], Term2 vt at ap v a)
Nothing -> ([Term2 vt at ap v a], Term2 vt at ap v a)
-> Maybe ([Term2 vt at ap v a], Term2 vt at ap v a)
forall a. a -> Maybe a
Just ([Term2 vt at ap v a
i], Term2 vt at ap v a
o)
  Term2 vt at ap v a
_ -> Maybe ([Term2 vt at ap v a], Term2 vt at ap v a)
forall a. Maybe a
Nothing

unApps ::
  Term2 vt at ap v a ->
  Maybe (Term2 vt at ap v a, [Term2 vt at ap v a])
unApps :: forall vt at ap v a.
Term2 vt at ap v a
-> Maybe (Term2 vt at ap v a, [Term2 vt at ap v a])
unApps Term2 vt at ap v a
t = (Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> Maybe (Term2 vt at ap v a, [Term2 vt at ap v a])
forall vt at ap v a.
(Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> Maybe (Term2 vt at ap v a, [Term2 vt at ap v a])
unAppsPred (Term2 vt at ap v a
t, Bool -> Term2 vt at ap v a -> Bool
forall a b. a -> b -> a
const Bool
True)

-- Same as unApps but taking a predicate controlling whether we match on a given function argument.
unAppsPred ::
  (Term2 vt at ap v a, Term2 vt at ap v a -> Bool) ->
  Maybe (Term2 vt at ap v a, [Term2 vt at ap v a])
unAppsPred :: forall vt at ap v a.
(Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> Maybe (Term2 vt at ap v a, [Term2 vt at ap v a])
unAppsPred (Term2 vt at ap v a
t, Term2 vt at ap v a -> Bool
pred) = case Term2 vt at ap v a -> [Term2 vt at ap v a] -> [Term2 vt at ap v a]
go Term2 vt at ap v a
t [] of [] -> Maybe (Term2 vt at ap v a, [Term2 vt at ap v a])
forall a. Maybe a
Nothing; Term2 vt at ap v a
f : [Term2 vt at ap v a]
args -> (Term2 vt at ap v a, [Term2 vt at ap v a])
-> Maybe (Term2 vt at ap v a, [Term2 vt at ap v a])
forall a. a -> Maybe a
Just (Term2 vt at ap v a
f, [Term2 vt at ap v a]
args)
  where
    go :: Term2 vt at ap v a -> [Term2 vt at ap v a] -> [Term2 vt at ap v a]
go (App' Term2 vt at ap v a
i Term2 vt at ap v a
o) [Term2 vt at ap v a]
acc | Term2 vt at ap v a -> Bool
pred Term2 vt at ap v a
o = Term2 vt at ap v a -> [Term2 vt at ap v a] -> [Term2 vt at ap v a]
go Term2 vt at ap v a
i (Term2 vt at ap v a
o Term2 vt at ap v a -> [Term2 vt at ap v a] -> [Term2 vt at ap v a]
forall a. a -> [a] -> [a]
: [Term2 vt at ap v a]
acc)
    go Term2 vt at ap v a
_ [] = []
    go Term2 vt at ap v a
fn [Term2 vt at ap v a]
args = Term2 vt at ap v a
fn Term2 vt at ap v a -> [Term2 vt at ap v a] -> [Term2 vt at ap v a]
forall a. a -> [a] -> [a]
: [Term2 vt at ap v a]
args

unBinaryApp ::
  Term2 vt at ap v a ->
  Maybe
    ( Term2 vt at ap v a,
      Term2 vt at ap v a,
      Term2 vt at ap v a
    )
unBinaryApp :: forall vt at ap v a.
Term2 vt at ap v a
-> Maybe
     (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a)
unBinaryApp Term2 vt at ap v a
t = case Term2 vt at ap v a
-> Maybe (Term2 vt at ap v a, [Term2 vt at ap v a])
forall vt at ap v a.
Term2 vt at ap v a
-> Maybe (Term2 vt at ap v a, [Term2 vt at ap v a])
unApps Term2 vt at ap v a
t of
  Just (Term2 vt at ap v a
f, [Term2 vt at ap v a
arg1, Term2 vt at ap v a
arg2]) -> (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a)
-> Maybe
     (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a)
forall a. a -> Maybe a
Just (Term2 vt at ap v a
f, Term2 vt at ap v a
arg1, Term2 vt at ap v a
arg2)
  Maybe (Term2 vt at ap v a, [Term2 vt at ap v a])
_ -> Maybe (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a)
forall a. Maybe a
Nothing

-- Special case for overapplied binary operators
unOverappliedBinaryAppPred ::
  (Term2 vt at ap v a, Term2 vt at ap v a -> Bool) ->
  Maybe
    ( Term2 vt at ap v a,
      Term2 vt at ap v a,
      Term2 vt at ap v a,
      [Term2 vt at ap v a]
    )
unOverappliedBinaryAppPred :: forall vt at ap v a.
(Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> Maybe
     (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a,
      [Term2 vt at ap v a])
unOverappliedBinaryAppPred (Term2 vt at ap v a
t, Term2 vt at ap v a -> Bool
pred) = case Term2 vt at ap v a
-> Maybe (Term2 vt at ap v a, [Term2 vt at ap v a])
forall vt at ap v a.
Term2 vt at ap v a
-> Maybe (Term2 vt at ap v a, [Term2 vt at ap v a])
unApps Term2 vt at ap v a
t of
  Just (Term2 vt at ap v a
f, Term2 vt at ap v a
arg1 : Term2 vt at ap v a
arg2 : [Term2 vt at ap v a]
rest) | Term2 vt at ap v a -> Bool
pred Term2 vt at ap v a
f -> (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a,
 [Term2 vt at ap v a])
-> Maybe
     (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a,
      [Term2 vt at ap v a])
forall a. a -> Maybe a
Just (Term2 vt at ap v a
f, Term2 vt at ap v a
arg1, Term2 vt at ap v a
arg2, [Term2 vt at ap v a]
rest)
  Maybe (Term2 vt at ap v a, [Term2 vt at ap v a])
_ -> Maybe
  (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a,
   [Term2 vt at ap v a])
forall a. Maybe a
Nothing

-- "((a1 `f1` a2) `f2` a3)" becomes "Just ([(a2, f2), (a1, f1)], a3)"
unBinaryApps ::
  Term2 vt at ap v a ->
  Maybe
    ( [(Term2 vt at ap v a, Term2 vt at ap v a)],
      Term2 vt at ap v a
    )
unBinaryApps :: forall vt at ap v a.
Term2 vt at ap v a
-> Maybe
     ([(Term2 vt at ap v a, Term2 vt at ap v a)], Term2 vt at ap v a)
unBinaryApps Term2 vt at ap v a
t = (Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> Maybe
     ([(Term2 vt at ap v a, Term2 vt at ap v a)], Term2 vt at ap v a)
forall vt at ap v a.
(Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> Maybe
     ([(Term2 vt at ap v a, Term2 vt at ap v a)], Term2 vt at ap v a)
unBinaryAppsPred (Term2 vt at ap v a
t, Bool -> Term2 vt at ap v a -> Bool
forall a b. a -> b -> a
const Bool
True)

-- Same as unBinaryApps but taking a predicate controlling whether we match on a given binary function.
unBinaryAppsPred ::
  ( Term2 vt at ap v a,
    Term2 vt at ap v a -> Bool
  ) ->
  Maybe
    ( [ ( Term2 vt at ap v a,
          Term2 vt at ap v a
        )
      ],
      Term2 vt at ap v a
    )
unBinaryAppsPred :: forall vt at ap v a.
(Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> Maybe
     ([(Term2 vt at ap v a, Term2 vt at ap v a)], Term2 vt at ap v a)
unBinaryAppsPred (Term2 vt at ap v a
t, Term2 vt at ap v a -> Bool
pred) = case (Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> Maybe
     (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a)
forall vt at ap v a.
(Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> Maybe
     (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a)
unBinaryAppPred (Term2 vt at ap v a
t, Term2 vt at ap v a -> Bool
pred) of
  Just (Term2 vt at ap v a
f, Term2 vt at ap v a
x, Term2 vt at ap v a
y) -> case (Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> Maybe
     ([(Term2 vt at ap v a, Term2 vt at ap v a)], Term2 vt at ap v a)
forall vt at ap v a.
(Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> Maybe
     ([(Term2 vt at ap v a, Term2 vt at ap v a)], Term2 vt at ap v a)
unBinaryAppsPred (Term2 vt at ap v a
x, Term2 vt at ap v a -> Bool
pred) of
    Just ([(Term2 vt at ap v a, Term2 vt at ap v a)]
as, Term2 vt at ap v a
xLast) -> ([(Term2 vt at ap v a, Term2 vt at ap v a)], Term2 vt at ap v a)
-> Maybe
     ([(Term2 vt at ap v a, Term2 vt at ap v a)], Term2 vt at ap v a)
forall a. a -> Maybe a
Just ((Term2 vt at ap v a
xLast, Term2 vt at ap v a
f) (Term2 vt at ap v a, Term2 vt at ap v a)
-> [(Term2 vt at ap v a, Term2 vt at ap v a)]
-> [(Term2 vt at ap v a, Term2 vt at ap v a)]
forall a. a -> [a] -> [a]
: [(Term2 vt at ap v a, Term2 vt at ap v a)]
as, Term2 vt at ap v a
y)
    Maybe
  ([(Term2 vt at ap v a, Term2 vt at ap v a)], Term2 vt at ap v a)
Nothing -> ([(Term2 vt at ap v a, Term2 vt at ap v a)], Term2 vt at ap v a)
-> Maybe
     ([(Term2 vt at ap v a, Term2 vt at ap v a)], Term2 vt at ap v a)
forall a. a -> Maybe a
Just ([(Term2 vt at ap v a
x, Term2 vt at ap v a
f)], Term2 vt at ap v a
y)
  Maybe (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a)
_ -> Maybe
  ([(Term2 vt at ap v a, Term2 vt at ap v a)], Term2 vt at ap v a)
forall a. Maybe a
Nothing

unBinaryAppPred ::
  (Term2 vt at ap v a, Term2 vt at ap v a -> Bool) ->
  Maybe
    ( Term2 vt at ap v a,
      Term2 vt at ap v a,
      Term2 vt at ap v a
    )
unBinaryAppPred :: forall vt at ap v a.
(Term2 vt at ap v a, Term2 vt at ap v a -> Bool)
-> Maybe
     (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a)
unBinaryAppPred (Term2 vt at ap v a
t, Term2 vt at ap v a -> Bool
pred) = case Term2 vt at ap v a
-> Maybe
     (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a)
forall vt at ap v a.
Term2 vt at ap v a
-> Maybe
     (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a)
unBinaryApp Term2 vt at ap v a
t of
  Just (Term2 vt at ap v a
f, Term2 vt at ap v a
x, Term2 vt at ap v a
y) | Term2 vt at ap v a -> Bool
pred Term2 vt at ap v a
f -> (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a)
-> Maybe
     (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a)
forall a. a -> Maybe a
Just (Term2 vt at ap v a
f, Term2 vt at ap v a
x, Term2 vt at ap v a
y)
  Maybe (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a)
_ -> Maybe (Term2 vt at ap v a, Term2 vt at ap v a, Term2 vt at ap v a)
forall a. Maybe a
Nothing

unLams' ::
  Term2 vt at ap v a -> Maybe ([v], Term2 vt at ap v a)
unLams' :: forall vt at ap v a.
Term2 vt at ap v a -> Maybe ([v], Term2 vt at ap v a)
unLams' Term2 vt at ap v a
t = (Term2 vt at ap v a, v -> Bool) -> Maybe ([v], Term2 vt at ap v a)
forall vt at ap v a.
(Term2 vt at ap v a, v -> Bool) -> Maybe ([v], Term2 vt at ap v a)
unLamsPred' (Term2 vt at ap v a
t, Bool -> v -> Bool
forall a b. a -> b -> a
const Bool
True)

-- Same as unLams', but always matches.  Returns an empty [v] if the term doesn't start with a
-- lambda extraction.
unLamsOpt' :: Term2 vt at ap v a -> Maybe ([v], Term2 vt at ap v a)
unLamsOpt' :: forall vt at ap v a.
Term2 vt at ap v a -> Maybe ([v], Term2 vt at ap v a)
unLamsOpt' Term2 vt at ap v a
t = case Term2 vt at ap v a -> Maybe ([v], Term2 vt at ap v a)
forall vt at ap v a.
Term2 vt at ap v a -> Maybe ([v], Term2 vt at ap v a)
unLams' Term2 vt at ap v a
t of
  r :: Maybe ([v], Term2 vt at ap v a)
r@(Just ([v], Term2 vt at ap v a)
_) -> Maybe ([v], Term2 vt at ap v a)
r
  Maybe ([v], Term2 vt at ap v a)
Nothing -> ([v], Term2 vt at ap v a) -> Maybe ([v], Term2 vt at ap v a)
forall a. a -> Maybe a
Just ([], Term2 vt at ap v a
t)

-- Same as unLams', but stops at any lambda which is considered a delay
unLamsUntilDelay' ::
  (Var v) =>
  Term2 vt at ap v a ->
  Maybe ([v], Term2 vt at ap v a)
unLamsUntilDelay' :: forall v vt at ap a.
Var v =>
Term2 vt at ap v a -> Maybe ([v], Term2 vt at ap v a)
unLamsUntilDelay' Term2 vt at ap v a
t = case (Term2 vt at ap v a, v -> Bool) -> Maybe ([v], Term2 vt at ap v a)
forall vt at ap v a.
(Term2 vt at ap v a, v -> Bool) -> Maybe ([v], Term2 vt at ap v a)
unLamsPred' (Term2 vt at ap v a
t, v -> Bool
forall {v}. Var v => v -> Bool
ok) of
  r :: Maybe ([v], Term2 vt at ap v a)
r@(Just ([v], Term2 vt at ap v a)
_) -> Maybe ([v], Term2 vt at ap v a)
r
  Maybe ([v], Term2 vt at ap v a)
Nothing -> ([v], Term2 vt at ap v a) -> Maybe ([v], Term2 vt at ap v a)
forall a. a -> Maybe a
Just ([], Term2 vt at ap v a
t)
  where
    ok :: v -> Bool
ok v
v = case v -> Type
forall v. Var v => v -> Type
Var.typeOf v
v of
      Var.User Text
"()" -> Bool
False
      Type
Var.Delay -> Bool
False
      Type
_ -> Bool
True

-- Same as unLams' but taking a predicate controlling whether we match on a given binary function.
unLamsPred' ::
  (Term2 vt at ap v a, v -> Bool) ->
  Maybe ([v], Term2 vt at ap v a)
unLamsPred' :: forall vt at ap v a.
(Term2 vt at ap v a, v -> Bool) -> Maybe ([v], Term2 vt at ap v a)
unLamsPred' (LamNamed' v
v Term2 vt at ap v a
body, v -> Bool
pred) | v -> Bool
pred v
v = case (Term2 vt at ap v a, v -> Bool) -> Maybe ([v], Term2 vt at ap v a)
forall vt at ap v a.
(Term2 vt at ap v a, v -> Bool) -> Maybe ([v], Term2 vt at ap v a)
unLamsPred' (Term2 vt at ap v a
body, v -> Bool
pred) of
  Maybe ([v], Term2 vt at ap v a)
Nothing -> ([v], Term2 vt at ap v a) -> Maybe ([v], Term2 vt at ap v a)
forall a. a -> Maybe a
Just ([v
v], Term2 vt at ap v a
body)
  Just ([v]
vs, Term2 vt at ap v a
body) -> ([v], Term2 vt at ap v a) -> Maybe ([v], Term2 vt at ap v a)
forall a. a -> Maybe a
Just (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
vs, Term2 vt at ap v a
body)
unLamsPred' (Term2 vt at ap v a, v -> Bool)
_ = Maybe ([v], Term2 vt at ap v a)
forall a. Maybe a
Nothing

unReqOrCtor :: Term2 vt at ap v a -> Maybe ConstructorReference
unReqOrCtor :: forall vt at ap v a.
Term2 vt at ap v a -> Maybe ConstructorReference
unReqOrCtor (Constructor' ConstructorReference
r) = ConstructorReference -> Maybe ConstructorReference
forall a. a -> Maybe a
Just ConstructorReference
r
unReqOrCtor (Request' ConstructorReference
r) = ConstructorReference -> Maybe ConstructorReference
forall a. a -> Maybe a
Just ConstructorReference
r
unReqOrCtor Term (F vt at ap) v a
_ = Maybe ConstructorReference
forall a. Maybe a
Nothing

-- Dependencies including referenced data and effect decls
dependencies :: (Ord v, Ord vt) => Term2 vt at ap v a -> DefnsF Set TermReference TypeReference
dependencies :: forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> DefnsF Set Reference Reference
dependencies =
  (DefnsF Set Reference Reference
 -> LabeledDependency -> DefnsF Set Reference Reference)
-> DefnsF Set Reference Reference
-> [LabeledDependency]
-> DefnsF Set Reference Reference
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' DefnsF Set Reference Reference
-> LabeledDependency -> DefnsF Set Reference Reference
f (Set Reference -> Set Reference -> DefnsF Set Reference Reference
forall terms types. terms -> types -> Defns terms types
Defns Set Reference
forall a. Set a
Set.empty Set Reference
forall a. Set a
Set.empty) ([LabeledDependency] -> DefnsF Set Reference Reference)
-> (Term2 vt at ap v a -> [LabeledDependency])
-> Term2 vt at ap v a
-> DefnsF Set Reference Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set LabeledDependency -> [LabeledDependency]
forall a. Set a -> [a]
Set.toList (Set LabeledDependency -> [LabeledDependency])
-> (Term2 vt at ap v a -> Set LabeledDependency)
-> Term2 vt at ap v a
-> [LabeledDependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term2 vt at ap v a -> Set LabeledDependency
forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> Set LabeledDependency
labeledDependencies
  where
    f ::
      DefnsF Set TermReference TypeReference ->
      LabeledDependency ->
      DefnsF Set TermReference TypeReference
    f :: DefnsF Set Reference Reference
-> LabeledDependency -> DefnsF Set Reference Reference
f DefnsF Set Reference Reference
deps = \case
      LD.TermReferent (Referent.Con ConstructorReference
ref ConstructorType
_) -> DefnsF Set Reference Reference
deps DefnsF Set Reference Reference
-> (DefnsF Set Reference Reference
    -> DefnsF Set Reference Reference)
-> DefnsF Set Reference Reference
forall a b. a -> (a -> b) -> b
& ASetter
  (DefnsF Set Reference Reference)
  (DefnsF Set Reference Reference)
  (Set Reference)
  (Set Reference)
-> (Set Reference -> Set Reference)
-> DefnsF Set Reference Reference
-> DefnsF Set Reference Reference
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (DefnsF Set Reference Reference)
  (DefnsF Set Reference Reference)
  (Set Reference)
  (Set Reference)
#types (Reference -> Set Reference -> Set Reference
forall a. Ord a => a -> Set a -> Set a
Set.insert (ConstructorReference
ref ConstructorReference
-> Getting Reference ConstructorReference Reference -> Reference
forall s a. s -> Getting a s a -> a
^. Getting Reference ConstructorReference Reference
forall r s (f :: * -> *).
Functor f =>
(r -> f s)
-> GConstructorReference r -> f (GConstructorReference s)
ConstructorReference.reference_))
      LD.TermReferent (Referent.Ref Reference
ref) -> DefnsF Set Reference Reference
deps DefnsF Set Reference Reference
-> (DefnsF Set Reference Reference
    -> DefnsF Set Reference Reference)
-> DefnsF Set Reference Reference
forall a b. a -> (a -> b) -> b
& ASetter
  (DefnsF Set Reference Reference)
  (DefnsF Set Reference Reference)
  (Set Reference)
  (Set Reference)
-> (Set Reference -> Set Reference)
-> DefnsF Set Reference Reference
-> DefnsF Set Reference Reference
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (DefnsF Set Reference Reference)
  (DefnsF Set Reference Reference)
  (Set Reference)
  (Set Reference)
#terms (Reference -> Set Reference -> Set Reference
forall a. Ord a => a -> Set a -> Set a
Set.insert Reference
ref)
      LD.TypeReference Reference
ref -> DefnsF Set Reference Reference
deps DefnsF Set Reference Reference
-> (DefnsF Set Reference Reference
    -> DefnsF Set Reference Reference)
-> DefnsF Set Reference Reference
forall a b. a -> (a -> b) -> b
& ASetter
  (DefnsF Set Reference Reference)
  (DefnsF Set Reference Reference)
  (Set Reference)
  (Set Reference)
-> (Set Reference -> Set Reference)
-> DefnsF Set Reference Reference
-> DefnsF Set Reference Reference
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (DefnsF Set Reference Reference)
  (DefnsF Set Reference Reference)
  (Set Reference)
  (Set Reference)
#types (Reference -> Set Reference -> Set Reference
forall a. Ord a => a -> Set a -> Set a
Set.insert Reference
ref)

termDependencies :: (Ord v, Ord vt) => Term2 vt at ap v a -> Set TermReference
termDependencies :: forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> Set Reference
termDependencies =
  (.terms) (DefnsF Set Reference Reference -> Set Reference)
-> (Term2 vt at ap v a -> DefnsF Set Reference Reference)
-> Term2 vt at ap v a
-> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term2 vt at ap v a -> DefnsF Set Reference Reference
forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> DefnsF Set Reference Reference
dependencies

-- gets types from annotations and constructors
typeDependencies :: (Ord v, Ord vt) => Term2 vt at ap v a -> Set Reference
typeDependencies :: forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> Set Reference
typeDependencies =
  (.types) (DefnsF Set Reference Reference -> Set Reference)
-> (Term2 vt at ap v a -> DefnsF Set Reference Reference)
-> Term2 vt at ap v a
-> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term2 vt at ap v a -> DefnsF Set Reference Reference
forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> DefnsF Set Reference Reference
dependencies

-- Gets the types to which this term contains references via patterns and
-- data constructors.
constructorDependencies ::
  (Ord v, Ord vt) => Term2 vt at ap v a -> Set Reference
constructorDependencies :: forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> Set Reference
constructorDependencies =
  Set (Set Reference) -> Set Reference
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
    (Set (Set Reference) -> Set Reference)
-> (Term2 vt at ap v a -> Set (Set Reference))
-> Term2 vt at ap v a
-> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> Set Reference)
-> (Reference -> Set Reference)
-> (Reference -> Set Reference)
-> (Reference -> Word64 -> Set Reference)
-> (Reference -> Set Reference)
-> (Reference -> Word64 -> Set Reference)
-> (Reference -> Set Reference)
-> Term2 vt at ap v a
-> Set (Set Reference)
forall v vt r at ap a.
(Ord v, Ord vt, Ord r) =>
(Reference -> r)
-> (Reference -> r)
-> (Reference -> r)
-> (Reference -> Word64 -> r)
-> (Reference -> r)
-> (Reference -> Word64 -> r)
-> (Reference -> r)
-> Term2 vt at ap v a
-> Set r
generalizedDependencies
      (Set Reference -> Reference -> Set Reference
forall a b. a -> b -> a
const Set Reference
forall a. Monoid a => a
mempty)
      (Set Reference -> Reference -> Set Reference
forall a b. a -> b -> a
const Set Reference
forall a. Monoid a => a
mempty)
      Reference -> Set Reference
forall a. a -> Set a
Set.singleton
      (Set Reference -> Word64 -> Set Reference
forall a b. a -> b -> a
const (Set Reference -> Word64 -> Set Reference)
-> (Reference -> Set Reference)
-> Reference
-> Word64
-> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Set Reference
forall a. a -> Set a
Set.singleton)
      Reference -> Set Reference
forall a. a -> Set a
Set.singleton
      (Set Reference -> Word64 -> Set Reference
forall a b. a -> b -> a
const (Set Reference -> Word64 -> Set Reference)
-> (Reference -> Set Reference)
-> Reference
-> Word64
-> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Set Reference
forall a. a -> Set a
Set.singleton)
      Reference -> Set Reference
forall a. a -> Set a
Set.singleton

generalizedDependencies ::
  (Ord v, Ord vt, Ord r) =>
  (Reference -> r) ->
  (Reference -> r) ->
  (Reference -> r) ->
  (Reference -> ConstructorId -> r) ->
  (Reference -> r) ->
  (Reference -> ConstructorId -> r) ->
  (Reference -> r) ->
  Term2 vt at ap v a ->
  Set r
generalizedDependencies :: forall v vt r at ap a.
(Ord v, Ord vt, Ord r) =>
(Reference -> r)
-> (Reference -> r)
-> (Reference -> r)
-> (Reference -> Word64 -> r)
-> (Reference -> r)
-> (Reference -> Word64 -> r)
-> (Reference -> r)
-> Term2 vt at ap v a
-> Set r
generalizedDependencies Reference -> r
termRef Reference -> r
typeRef Reference -> r
literalType Reference -> Word64 -> r
dataConstructor Reference -> r
dataType Reference -> Word64 -> r
effectConstructor Reference -> r
effectType =
  [r] -> Set r
forall a. Ord a => [a] -> Set a
Set.fromList ([r] -> Set r)
-> (Term2 vt at ap v a -> [r]) -> Term2 vt at ap v a -> Set r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer [r] (Term2 vt at ap v a) -> [r]
forall w a. Writer w a -> w
Writer.execWriter (Writer [r] (Term2 vt at ap v a) -> [r])
-> (Term2 vt at ap v a -> Writer [r] (Term2 vt at ap v a))
-> Term2 vt at ap v a
-> [r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (F vt at ap (Term2 vt at ap v a)
 -> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a)))
-> Term2 vt at ap v a -> Writer [r] (Term2 vt at ap v a)
forall (f :: * -> *) (g :: * -> *) v a.
(Traversable f, Monad g, Ord v) =>
(f (Term f v a) -> g (f (Term f v a)))
-> Term f v a -> g (Term f v a)
ABT.visit' F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
f
  where
    f :: F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
f t :: F vt at ap (Term2 vt at ap v a)
t@(Ref Reference
r) = [r] -> WriterT [r] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell [Reference -> r
termRef Reference
r] WriterT [r] Identity ()
-> F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> F vt at ap (Term2 vt at ap v a)
t
    f t :: F vt at ap (Term2 vt at ap v a)
t@(TermLink Referent
r) = case Referent
r of
      Referent.Ref Reference
r -> [r] -> WriterT [r] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell [Reference -> r
termRef Reference
r] WriterT [r] Identity ()
-> F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> F vt at ap (Term2 vt at ap v a)
t
      Referent.Con (ConstructorReference Reference
r Word64
id) ConstructorType
CT.Data -> [r] -> WriterT [r] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell [Reference -> Word64 -> r
dataConstructor Reference
r Word64
id] WriterT [r] Identity ()
-> F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> F vt at ap (Term2 vt at ap v a)
t
      Referent.Con (ConstructorReference Reference
r Word64
id) ConstructorType
CT.Effect -> [r] -> WriterT [r] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell [Reference -> Word64 -> r
effectConstructor Reference
r Word64
id] WriterT [r] Identity ()
-> F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> F vt at ap (Term2 vt at ap v a)
t
    f t :: F vt at ap (Term2 vt at ap v a)
t@(TypeLink Reference
r) = [r] -> WriterT [r] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell [Reference -> r
typeRef Reference
r] WriterT [r] Identity ()
-> F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> F vt at ap (Term2 vt at ap v a)
t
    f t :: F vt at ap (Term2 vt at ap v a)
t@(Ann Term2 vt at ap v a
_ Type vt at
typ) =
      [r] -> WriterT [r] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell ((Reference -> r) -> [Reference] -> [r]
forall a b. (a -> b) -> [a] -> [b]
map Reference -> r
typeRef ([Reference] -> [r])
-> (Set Reference -> [Reference]) -> Set Reference -> [r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Reference -> [Reference]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Reference -> [r]) -> Set Reference -> [r]
forall a b. (a -> b) -> a -> b
$ Type vt at -> Set Reference
forall v a. Ord v => Type v a -> Set Reference
Type.dependencies Type vt at
typ) WriterT [r] Identity ()
-> F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> F vt at ap (Term2 vt at ap v a)
t
    f t :: F vt at ap (Term2 vt at ap v a)
t@(Nat Word64
_) = [r] -> WriterT [r] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell [Reference -> r
literalType Reference
Type.natRef] WriterT [r] Identity ()
-> F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> F vt at ap (Term2 vt at ap v a)
t
    f t :: F vt at ap (Term2 vt at ap v a)
t@(Int Int64
_) = [r] -> WriterT [r] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell [Reference -> r
literalType Reference
Type.intRef] WriterT [r] Identity ()
-> F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> F vt at ap (Term2 vt at ap v a)
t
    f t :: F vt at ap (Term2 vt at ap v a)
t@(Float Double
_) = [r] -> WriterT [r] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell [Reference -> r
literalType Reference
Type.floatRef] WriterT [r] Identity ()
-> F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> F vt at ap (Term2 vt at ap v a)
t
    f t :: F vt at ap (Term2 vt at ap v a)
t@(Boolean Bool
_) = [r] -> WriterT [r] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell [Reference -> r
literalType Reference
Type.booleanRef] WriterT [r] Identity ()
-> F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> F vt at ap (Term2 vt at ap v a)
t
    f t :: F vt at ap (Term2 vt at ap v a)
t@(Text Text
_) = [r] -> WriterT [r] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell [Reference -> r
literalType Reference
Type.textRef] WriterT [r] Identity ()
-> F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> F vt at ap (Term2 vt at ap v a)
t
    f t :: F vt at ap (Term2 vt at ap v a)
t@(List Seq (Term2 vt at ap v a)
_) = [r] -> WriterT [r] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell [Reference -> r
literalType Reference
Type.listRef] WriterT [r] Identity ()
-> F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> F vt at ap (Term2 vt at ap v a)
t
    f t :: F vt at ap (Term2 vt at ap v a)
t@(Constructor (ConstructorReference Reference
r Word64
cid)) =
      [r] -> WriterT [r] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell [Reference -> r
dataType Reference
r, Reference -> Word64 -> r
dataConstructor Reference
r Word64
cid] WriterT [r] Identity ()
-> F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> F vt at ap (Term2 vt at ap v a)
t
    f t :: F vt at ap (Term2 vt at ap v a)
t@(Request (ConstructorReference Reference
r Word64
cid)) =
      [r] -> WriterT [r] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell [Reference -> r
effectType Reference
r, Reference -> Word64 -> r
effectConstructor Reference
r Word64
cid] WriterT [r] Identity ()
-> F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> F vt at ap (Term2 vt at ap v a)
t
    f t :: F vt at ap (Term2 vt at ap v a)
t@(Match Term2 vt at ap v a
_ [MatchCase ap (Term2 vt at ap v a)]
cases) = (MatchCase ap (Term2 vt at ap v a) -> WriterT [r] Identity ())
-> [MatchCase ap (Term2 vt at ap v a)] -> WriterT [r] Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ MatchCase ap (Term2 vt at ap v a) -> WriterT [r] Identity ()
goPat [MatchCase ap (Term2 vt at ap v a)]
cases WriterT [r] Identity ()
-> F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> F vt at ap (Term2 vt at ap v a)
t
    f F vt at ap (Term2 vt at ap v a)
t = F vt at ap (Term2 vt at ap v a)
-> WriterT [r] Identity (F vt at ap (Term2 vt at ap v a))
forall a. a -> WriterT [r] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure F vt at ap (Term2 vt at ap v a)
t
    goPat :: MatchCase ap (Term2 vt at ap v a) -> WriterT [r] Identity ()
goPat (MatchCase Pattern ap
pat Maybe (Term2 vt at ap v a)
_ Term2 vt at ap v a
_) =
      [r] -> WriterT [r] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Writer.tell ([r] -> WriterT [r] Identity ())
-> (Set r -> [r]) -> Set r -> WriterT [r] Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set r -> [r]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set r -> WriterT [r] Identity ())
-> Set r -> WriterT [r] Identity ()
forall a b. (a -> b) -> a -> b
$
        (Reference -> r)
-> (Reference -> Word64 -> r)
-> (Reference -> r)
-> (Reference -> Word64 -> r)
-> (Reference -> r)
-> Pattern ap
-> Set r
forall r loc.
Ord r =>
(Reference -> r)
-> (Reference -> Word64 -> r)
-> (Reference -> r)
-> (Reference -> Word64 -> r)
-> (Reference -> r)
-> Pattern loc
-> Set r
Pattern.generalizedDependencies
          Reference -> r
literalType
          Reference -> Word64 -> r
dataConstructor
          Reference -> r
dataType
          Reference -> Word64 -> r
effectConstructor
          Reference -> r
effectType
          Pattern ap
pat

labeledDependencies ::
  (Ord v, Ord vt) => Term2 vt at ap v a -> Set LabeledDependency
labeledDependencies :: forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> Set LabeledDependency
labeledDependencies =
  (Reference -> LabeledDependency)
-> (Reference -> LabeledDependency)
-> (Reference -> LabeledDependency)
-> (Reference -> Word64 -> LabeledDependency)
-> (Reference -> LabeledDependency)
-> (Reference -> Word64 -> LabeledDependency)
-> (Reference -> LabeledDependency)
-> Term2 vt at ap v a
-> Set LabeledDependency
forall v vt r at ap a.
(Ord v, Ord vt, Ord r) =>
(Reference -> r)
-> (Reference -> r)
-> (Reference -> r)
-> (Reference -> Word64 -> r)
-> (Reference -> r)
-> (Reference -> Word64 -> r)
-> (Reference -> r)
-> Term2 vt at ap v a
-> Set r
generalizedDependencies
    Reference -> LabeledDependency
LD.termRef
    Reference -> LabeledDependency
LD.typeRef
    Reference -> LabeledDependency
LD.typeRef
    (\Reference
r Word64
i -> ConstructorReference -> LabeledDependency
LD.dataConstructor (Reference -> Word64 -> ConstructorReference
forall r. r -> Word64 -> GConstructorReference r
ConstructorReference Reference
r Word64
i))
    Reference -> LabeledDependency
LD.typeRef
    (\Reference
r Word64
i -> ConstructorReference -> LabeledDependency
LD.effectConstructor (Reference -> Word64 -> ConstructorReference
forall r. r -> Word64 -> GConstructorReference r
ConstructorReference Reference
r Word64
i))
    Reference -> LabeledDependency
LD.typeRef

updateDependencies ::
  (Ord v) =>
  Map Referent Referent ->
  Map Reference Reference ->
  Term v a ->
  Term v a
updateDependencies :: forall v a.
Ord v =>
Map Referent Referent
-> Map Reference Reference -> Term v a -> Term v a
updateDependencies Map Referent Referent
termUpdates Map Reference Reference
typeUpdates = (F v a a (Term (F v a a) v a) -> F v a a (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a
forall v (f :: * -> *) a.
(Ord v, Foldable f, Functor f) =>
(f (Term f v a) -> f (Term f v a)) -> Term f v a -> Term f v a
ABT.rebuildUp F v a a (Term (F v a a) v a) -> F v a a (Term (F v a a) v a)
go
  where
    referent :: Referent -> F typeVar typeAnn patternAnn a
referent (Referent.Ref Reference
r) = Reference -> F typeVar typeAnn patternAnn a
forall typeVar typeAnn patternAnn a.
Reference -> F typeVar typeAnn patternAnn a
Ref Reference
r
    referent (Referent.Con ConstructorReference
r ConstructorType
CT.Data) = ConstructorReference -> F typeVar typeAnn patternAnn a
forall typeVar typeAnn patternAnn a.
ConstructorReference -> F typeVar typeAnn patternAnn a
Constructor ConstructorReference
r
    referent (Referent.Con ConstructorReference
r ConstructorType
CT.Effect) = ConstructorReference -> F typeVar typeAnn patternAnn a
forall typeVar typeAnn patternAnn a.
ConstructorReference -> F typeVar typeAnn patternAnn a
Request ConstructorReference
r
    go :: F v a a (Term (F v a a) v a) -> F v a a (Term (F v a a) v a)
go (Ref Reference
r) = case Referent -> Map Referent Referent -> Maybe Referent
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Reference -> Referent
Referent.Ref Reference
r) Map Referent Referent
termUpdates of
      Maybe Referent
Nothing -> Reference -> F v a a (Term (F v a a) v a)
forall typeVar typeAnn patternAnn a.
Reference -> F typeVar typeAnn patternAnn a
Ref Reference
r
      Just Referent
r -> Referent -> F v a a (Term (F v a a) v a)
forall typeVar typeAnn patternAnn a.
Referent -> F typeVar typeAnn patternAnn a
referent Referent
r
    go ct :: F v a a (Term (F v a a) v a)
ct@(Constructor ConstructorReference
r) = case Referent -> Map Referent Referent -> Maybe Referent
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ConstructorReference -> ConstructorType -> Referent
Referent.Con ConstructorReference
r ConstructorType
CT.Data) Map Referent Referent
termUpdates of
      Maybe Referent
Nothing -> F v a a (Term (F v a a) v a)
ct
      Just Referent
r -> Referent -> F v a a (Term (F v a a) v a)
forall typeVar typeAnn patternAnn a.
Referent -> F typeVar typeAnn patternAnn a
referent Referent
r
    go req :: F v a a (Term (F v a a) v a)
req@(Request ConstructorReference
r) = case Referent -> Map Referent Referent -> Maybe Referent
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ConstructorReference -> ConstructorType -> Referent
Referent.Con ConstructorReference
r ConstructorType
CT.Effect) Map Referent Referent
termUpdates of
      Maybe Referent
Nothing -> F v a a (Term (F v a a) v a)
req
      Just Referent
r -> Referent -> F v a a (Term (F v a a) v a)
forall typeVar typeAnn patternAnn a.
Referent -> F typeVar typeAnn patternAnn a
referent Referent
r
    go (TermLink Referent
r) = Referent -> F v a a (Term (F v a a) v a)
forall typeVar typeAnn patternAnn a.
Referent -> F typeVar typeAnn patternAnn a
TermLink (Referent -> Referent -> Map Referent Referent -> Referent
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Referent
r Referent
r Map Referent Referent
termUpdates)
    go (TypeLink Reference
r) = Reference -> F v a a (Term (F v a a) v a)
forall typeVar typeAnn patternAnn a.
Reference -> F typeVar typeAnn patternAnn a
TypeLink (Reference -> Reference -> Map Reference Reference -> Reference
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Reference
r Reference
r Map Reference Reference
typeUpdates)
    go (Ann Term (F v a a) v a
tm Type v a
tp) = Term (F v a a) v a -> Type v a -> F v a a (Term (F v a a) v a)
forall typeVar typeAnn patternAnn a.
a -> Type typeVar typeAnn -> F typeVar typeAnn patternAnn a
Ann Term (F v a a) v a
tm (Type v a -> F v a a (Term (F v a a) v a))
-> Type v a -> F v a a (Term (F v a a) v a)
forall a b. (a -> b) -> a -> b
$ Map Reference Reference -> Type v a -> Type v a
forall v a.
Ord v =>
Map Reference Reference -> Type v a -> Type v a
Type.updateDependencies Map Reference Reference
typeUpdates Type v a
tp
    go (Match Term (F v a a) v a
tm [MatchCase a (Term (F v a a) v a)]
cases) = Term (F v a a) v a
-> [MatchCase a (Term (F v a a) v a)]
-> F v a a (Term (F v a a) v a)
forall typeVar typeAnn patternAnn a.
a -> [MatchCase patternAnn a] -> F typeVar typeAnn patternAnn a
Match Term (F v a a) v a
tm (MatchCase a (Term (F v a a) v a)
-> MatchCase a (Term (F v a a) v a)
u (MatchCase a (Term (F v a a) v a)
 -> MatchCase a (Term (F v a a) v a))
-> [MatchCase a (Term (F v a a) v a)]
-> [MatchCase a (Term (F v a a) v a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MatchCase a (Term (F v a a) v a)]
cases)
      where
        u :: MatchCase a (Term (F v a a) v a)
-> MatchCase a (Term (F v a a) v a)
u (MatchCase Pattern a
pat Maybe (Term (F v a a) v a)
g Term (F v a a) v a
b) = Pattern a
-> Maybe (Term (F v a a) v a)
-> Term (F v a a) v a
-> MatchCase a (Term (F v a a) v a)
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
MatchCase (Map Referent Referent -> Pattern a -> Pattern a
forall loc. Map Referent Referent -> Pattern loc -> Pattern loc
Pattern.updateDependencies Map Referent Referent
termUpdates Pattern a
pat) Maybe (Term (F v a a) v a)
g Term (F v a a) v a
b
    go F v a a (Term (F v a a) v a)
f = F v a a (Term (F v a a) v a)
f

-- | If the outermost term is a function application,
-- perform substitution of the argument into the body
betaReduce :: (Var v) => Term0 v -> Term0 v
betaReduce :: forall v. Var v => Term0 v -> Term0 v
betaReduce (App' (Lam' Subst (F v () ()) v ()
f) Term (F v () ()) v ()
arg) = Subst (F v () ()) v ()
-> Term (F v () ()) v () -> Term (F v () ()) v ()
forall (f :: * -> *) v a. Subst f v a -> Term f v a -> Term f v a
ABT.bind Subst (F v () ()) v ()
f Term (F v () ()) v ()
arg
betaReduce Term (F v () ()) v ()
e = Term (F v () ()) v ()
e

betaNormalForm :: (Var v) => Term0 v -> Term0 v
betaNormalForm :: forall v. Var v => Term0 v -> Term0 v
betaNormalForm (App' Term (F v () ()) v ()
f Term (F v () ()) v ()
a) = Term (F v () ()) v () -> Term (F v () ()) v ()
forall v. Var v => Term0 v -> Term0 v
betaNormalForm (Term (F v () ()) v () -> Term (F v () ()) v ()
forall v. Var v => Term0 v -> Term0 v
betaReduce (()
-> Term (F v () ()) v ()
-> Term (F v () ()) v ()
-> Term (F v () ()) v ()
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
app () (Term (F v () ()) v () -> Term (F v () ()) v ()
forall v. Var v => Term0 v -> Term0 v
betaNormalForm Term (F v () ()) v ()
f) Term (F v () ()) v ()
a))
betaNormalForm Term (F v () ()) v ()
e = Term (F v () ()) v ()
e

-- x -> f x => f
etaNormalForm :: (Ord v) => Term0 v -> Term0 v
etaNormalForm :: forall v. Ord v => Term0 v -> Term0 v
etaNormalForm Term0 v
tm = case Term0 v
tm of
  LamNamed' v
v Term0 v
body -> Term0 v -> Term0 v
forall {a} {vt} {a}.
Ord a =>
Term (F vt a a) a a -> Term (F vt a a) a a
step (Term0 v -> Term0 v) -> (Term0 v -> Term0 v) -> Term0 v -> Term0 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> ((), v) -> Term0 v -> Term0 v
forall v a vt at ap.
Ord v =>
a -> (a, v) -> Term2 vt at ap v a -> Term2 vt at ap v a
lam () ((), v
v) (Term0 v -> Term0 v) -> Term0 v -> Term0 v
forall a b. (a -> b) -> a -> b
$ Term0 v -> Term0 v
forall v. Ord v => Term0 v -> Term0 v
etaNormalForm Term0 v
body
    where
      step :: Term (F vt a a) a a -> Term (F vt a a) a a
step (LamNamed' a
v (App' Term (F vt a a) a a
f (Var' a
v')))
        | a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v', a
v a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Term (F vt a a) a a -> Set a
forall vt v a. Term' vt v a -> Set v
freeVars Term (F vt a a) a a
f = Term (F vt a a) a a
f
      step Term (F vt a a) a a
tm = Term (F vt a a) a a
tm
  Term0 v
_ -> Term0 v
tm

-- x -> f x => f as long as `x` is a variable of type `Var.Eta`
etaReduceEtaVars :: (Var v) => Term0 v -> Term0 v
etaReduceEtaVars :: forall v. Var v => Term0 v -> Term0 v
etaReduceEtaVars Term0 v
tm = case Term0 v
tm of
  LamNamed' v
v Term0 v
body -> Term0 v -> Term0 v
forall {a} {vt} {a}.
Var a =>
Term (F vt a a) a a -> Term (F vt a a) a a
step (Term0 v -> Term0 v) -> (Term0 v -> Term0 v) -> Term0 v -> Term0 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> ((), v) -> Term0 v -> Term0 v
forall v a vt at ap.
Ord v =>
a -> (a, v) -> Term2 vt at ap v a -> Term2 vt at ap v a
lam (Term0 v -> ()
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term0 v
tm) ((), v
v) (Term0 v -> Term0 v) -> Term0 v -> Term0 v
forall a b. (a -> b) -> a -> b
$ Term0 v -> Term0 v
forall v. Var v => Term0 v -> Term0 v
etaReduceEtaVars Term0 v
body
    where
      ok :: a -> a -> Term' vt a a -> Bool
ok a
v a
v' Term' vt a a
f =
        a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v'
          Bool -> Bool -> Bool
&& a -> Type
forall v. Var v => v -> Type
Var.typeOf a
v Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
Var.Eta
          Bool -> Bool -> Bool
&& a
v a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Term' vt a a -> Set a
forall vt v a. Term' vt v a -> Set v
freeVars Term' vt a a
f
      step :: Term (F vt a a) a a -> Term (F vt a a) a a
step (LamNamed' a
v (App' Term (F vt a a) a a
f (Var' a
v'))) | a -> a -> Term (F vt a a) a a -> Bool
forall {a} {vt} {a}. Var a => a -> a -> Term' vt a a -> Bool
ok a
v a
v' Term (F vt a a) a a
f = Term (F vt a a) a a
f
      step Term (F vt a a) a a
tm = Term (F vt a a) a a
tm
  Term0 v
_ -> Term0 v
tm

-- This converts `Reference`s it finds that are in the input `Map`
-- back to free variables
unhashComponent ::
  forall v a.
  (Var v) =>
  Map Reference.Id (Term v a) ->
  Map Reference.Id (v, Term v a)
unhashComponent :: forall v a. Var v => Map Id (Term v a) -> Map Id (v, Term v a)
unhashComponent Map Id (Term v a)
m =
  let usedVars :: Set v
usedVars = (Term v a -> Set v) -> Map Id (Term v a) -> Set v
forall m a. Monoid m => (a -> m) -> Map Id a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([v] -> Set v) -> (Term v a -> [v]) -> Term v a -> Set v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v a -> [v]
forall (f :: * -> *) v a. Foldable f => Term f v a -> [v]
ABT.allVars) Map Id (Term v a)
m
      m' :: Map Reference.Id (v, Term v a)
      m' :: Map Id (v, Term v a)
m' = State (Set v) (Map Id (v, Term v a))
-> Set v -> Map Id (v, Term v a)
forall s a. State s a -> s -> a
evalState ((Id -> Term v a -> StateT (Set v) Identity (v, Term v a))
-> Map Id (Term v a) -> State (Set v) (Map Id (v, Term v a))
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey Id -> Term v a -> StateT (Set v) Identity (v, Term v a)
forall {f :: * -> *} {a} {t}.
(MonadState (Set a) f, Var a) =>
Id -> t -> f (a, t)
assignVar Map Id (Term v a)
m) Set v
usedVars
        where
          assignVar :: Id -> t -> f (a, t)
assignVar Id
r t
t = (,t
t) (a -> (a, t)) -> f a -> f (a, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
forall v (m :: * -> *). (Var v, MonadState (Set v) m) => v -> m v
ABT.freshenS (Id -> a
forall v. Var v => Id -> v
Var.unnamedRef Id
r)
      unhash1 :: Term v a -> Term v a
      unhash1 :: Term v a -> Term v a
unhash1 = (Term v a -> Term v a) -> Term v a -> Term v a
forall v (f :: * -> *) a.
(Ord v, Foldable f, Functor f) =>
(Term f v a -> Term f v a) -> Term f v a -> Term f v a
ABT.rebuildUp' Term v a -> Term v a
go
        where
          go :: Term v a -> Term v a
go e :: Term v a
e@(Ref' (Reference.DerivedId Id
r)) = case Id -> Map Id (v, Term v a) -> Maybe (v, Term v a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id
r Map Id (v, Term v a)
m' of
            Maybe (v, Term v a)
Nothing -> Term v a
e
            Just (v
v, Term v a
_) -> 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
e) v
v
          go Term v a
e = Term v a
e
   in (Term v a -> Term v a) -> (v, Term v a) -> (v, Term v a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Term v a -> Term v a
unhash1 ((v, Term v a) -> (v, Term v a))
-> Map Id (v, Term v a) -> Map Id (v, Term v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Id (v, Term v a)
m'

fromReferent ::
  (Ord v) =>
  a ->
  Referent ->
  Term2 vt at ap v a
fromReferent :: forall v a vt at ap. Ord v => a -> Referent -> Term2 vt at ap v a
fromReferent a
a = \case
  Referent.Ref Reference
r -> 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 a
a Reference
r
  Referent.Con ConstructorReference
r ConstructorType
ct -> case ConstructorType
ct of
    ConstructorType
CT.Data -> a -> ConstructorReference -> Term2 vt at ap v a
forall v a vt at ap.
Ord v =>
a -> ConstructorReference -> Term2 vt at ap v a
constructor a
a ConstructorReference
r
    ConstructorType
CT.Effect -> a -> ConstructorReference -> Term2 vt at ap v a
forall v a vt at ap.
Ord v =>
a -> ConstructorReference -> Term2 vt at ap v a
request a
a ConstructorReference
r

-- Used to find matches of `@rewrite case` rules
containsExpression :: (Var v, Var typeVar, Eq typeAnn) => Term2 typeVar typeAnn loc v a -> Term2 typeVar typeAnn loc v a -> Bool
containsExpression :: forall v typeVar typeAnn loc a.
(Var v, Var typeVar, Eq typeAnn) =>
Term2 typeVar typeAnn loc v a
-> Term2 typeVar typeAnn loc v a -> Bool
containsExpression = Term (F typeVar typeAnn loc) v a
-> Term (F typeVar typeAnn loc) v a -> Bool
forall (f :: * -> *) v a.
(Var v, forall a1. Eq a1 => Eq (f a1), Traversable f) =>
Term f v a -> Term f v a -> Bool
ABT.containsExpression

-- Used to find matches of `@rewrite case` rules
-- Returns `Nothing` if `pat` can't be interpreted as a `Pattern`
-- (like `1 + 1` is not a valid pattern, but `Some x` can be)
containsCaseTerm :: (Var v1) => Term2 tv ta tb v1 loc -> Term2 typeVar typeAnn loc v2 a -> Maybe Bool
containsCaseTerm :: forall v1 tv ta tb loc typeVar typeAnn v2 a.
Var v1 =>
Term2 tv ta tb v1 loc
-> Term2 typeVar typeAnn loc v2 a -> Maybe Bool
containsCaseTerm Term2 tv ta tb v1 loc
pat =
  (\Term2 typeVar typeAnn loc v2 a
tm -> Pattern loc -> Term2 typeVar typeAnn loc v2 a -> Bool
forall loc typeVar typeAnn v a.
Pattern loc -> Term2 typeVar typeAnn loc v a -> Bool
containsCase (Pattern loc -> Term2 typeVar typeAnn loc v2 a -> Bool)
-> Maybe (Pattern loc)
-> Maybe (Term2 typeVar typeAnn loc v2 a -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Pattern loc)
pat' Maybe (Term2 typeVar typeAnn loc v2 a -> Bool)
-> Maybe (Term2 typeVar typeAnn loc v2 a) -> Maybe Bool
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term2 typeVar typeAnn loc v2 a
-> Maybe (Term2 typeVar typeAnn loc v2 a)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term2 typeVar typeAnn loc v2 a
tm)
  where
    pat' :: Maybe (Pattern loc)
pat' = Term2 tv ta tb v1 loc -> Maybe (Pattern loc)
forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern Term2 tv ta tb v1 loc
pat

-- Implementation detail / core logic of `containsCaseTerm`
containsCase :: Pattern loc -> Term2 typeVar typeAnn loc v a -> Bool
containsCase :: forall loc typeVar typeAnn v a.
Pattern loc -> Term2 typeVar typeAnn loc v a -> Bool
containsCase Pattern loc
pat Term2 typeVar typeAnn loc v a
tm = case Term2 typeVar typeAnn loc v a
-> ABT (F typeVar typeAnn loc) v (Term2 typeVar typeAnn loc v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out Term2 typeVar typeAnn loc v a
tm of
  ABT.Var v
_ -> Bool
False
  ABT.Cycle Term2 typeVar typeAnn loc v a
tm -> Pattern loc -> Term2 typeVar typeAnn loc v a -> Bool
forall loc typeVar typeAnn v a.
Pattern loc -> Term2 typeVar typeAnn loc v a -> Bool
containsCase Pattern loc
pat Term2 typeVar typeAnn loc v a
tm
  ABT.Abs v
_ Term2 typeVar typeAnn loc v a
tm -> Pattern loc -> Term2 typeVar typeAnn loc v a -> Bool
forall loc typeVar typeAnn v a.
Pattern loc -> Term2 typeVar typeAnn loc v a -> Bool
containsCase Pattern loc
pat Term2 typeVar typeAnn loc v a
tm
  ABT.Tm (Match Term2 typeVar typeAnn loc v a
scrute [MatchCase loc (Term2 typeVar typeAnn loc v a)]
cases) ->
    Pattern loc -> Term2 typeVar typeAnn loc v a -> Bool
forall loc typeVar typeAnn v a.
Pattern loc -> Term2 typeVar typeAnn loc v a -> Bool
containsCase Pattern loc
pat Term2 typeVar typeAnn loc v a
scrute Bool -> Bool -> Bool
|| (MatchCase loc (Term2 typeVar typeAnn loc v a) -> Bool)
-> [MatchCase loc (Term2 typeVar typeAnn loc v a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any MatchCase loc (Term2 typeVar typeAnn loc v a) -> Bool
hasPat [MatchCase loc (Term2 typeVar typeAnn loc v a)]
cases
    where
      hasPat :: MatchCase loc (Term2 typeVar typeAnn loc v a) -> Bool
hasPat (MatchCase Pattern loc
p Maybe (Term2 typeVar typeAnn loc v a)
_ Term2 typeVar typeAnn loc v a
rhs) = Pattern loc -> Pattern loc -> Bool
forall loc. Pattern loc -> Pattern loc -> Bool
Pattern.hasSubpattern Pattern loc
pat Pattern loc
p Bool -> Bool -> Bool
|| Pattern loc -> Term2 typeVar typeAnn loc v a -> Bool
forall loc typeVar typeAnn v a.
Pattern loc -> Term2 typeVar typeAnn loc v a -> Bool
containsCase Pattern loc
pat Term2 typeVar typeAnn loc v a
rhs
  ABT.Tm F typeVar typeAnn loc (Term2 typeVar typeAnn loc v a)
f -> (Term2 typeVar typeAnn loc v a -> Bool)
-> [Term2 typeVar typeAnn loc v a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pattern loc -> Term2 typeVar typeAnn loc v a -> Bool
forall loc typeVar typeAnn v a.
Pattern loc -> Term2 typeVar typeAnn loc v a -> Bool
containsCase Pattern loc
pat) (F typeVar typeAnn loc (Term2 typeVar typeAnn loc v a)
-> [Term2 typeVar typeAnn loc v a]
forall a. F typeVar typeAnn loc a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList F typeVar typeAnn loc (Term2 typeVar typeAnn loc v a)
f)

-- Used to find matches of `@rewrite signature` rules
containsSignature :: (Ord v, ABT.Var vt, Show vt) => Type vt at -> Term2 vt at ap v a -> Bool
containsSignature :: forall v vt at ap a.
(Ord v, Var vt, Show vt) =>
Type vt at -> Term2 vt at ap v a -> Bool
containsSignature Type vt at
tyLhs Term2 vt at ap v a
tm = (Term2 vt at ap v a -> Bool) -> [Term2 vt at ap v a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Term2 vt at ap v a -> Bool
ok (Term2 vt at ap v a -> [Term2 vt at ap v a]
forall v (f :: * -> *) a.
(Ord v, Traversable f) =>
Term f v a -> [Term f v a]
ABT.subterms Term2 vt at ap v a
tm)
  where
    ok :: Term2 vt at ap v a -> Bool
ok (Ann' Term2 vt at ap v a
_ Type vt at
tp) = Type vt at -> Type vt at -> Bool
forall (f :: * -> *) v a.
(Var v, forall a1. Eq a1 => Eq (f a1), Traversable f) =>
Term f v a -> Term f v a -> Bool
ABT.containsExpression Type vt at
tyLhs Type vt at
tp
    ok Term2 vt at ap v a
_ = Bool
False

-- Used to rewrite type signatures in terms (`@rewrite signature` rules)
rewriteSignatures :: (Ord v, ABT.Var vt, Show vt) => Type vt at -> Type vt at -> Term2 vt at ap v a -> Maybe (Term2 vt at ap v a)
rewriteSignatures :: forall v vt at ap a.
(Ord v, Var vt, Show vt) =>
Type vt at
-> Type vt at -> Term2 vt at ap v a -> Maybe (Term2 vt at ap v a)
rewriteSignatures Type vt at
tyLhs Type vt at
tyRhs Term2 vt at ap v a
tm = (Term2 vt at ap v a -> Maybe (Term2 vt at ap v a))
-> Term2 vt at ap v a -> Maybe (Term2 vt at ap v a)
forall v (f :: * -> *) a.
(Ord v, Foldable f, Functor f) =>
(Term f v a -> Maybe (Term f v a))
-> Term f v a -> Maybe (Term f v a)
ABT.rebuildMaybeUp Term2 vt at ap v a -> Maybe (Term2 vt at ap v a)
go Term2 vt at ap v a
tm
  where
    go :: Term2 vt at ap v a -> Maybe (Term2 vt at ap v a)
go a :: Term2 vt at ap v a
a@(Ann' Term2 vt at ap v a
tm Type vt at
tp) = a -> Term2 vt at ap v a -> Type vt at -> Term2 vt at ap 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 (Term2 vt at ap v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term2 vt at ap v a
a) Term2 vt at ap v a
tm (Type vt at -> Term2 vt at ap v a)
-> Maybe (Type vt at) -> Maybe (Term2 vt at ap v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type vt at -> Type vt at -> Type vt at -> Maybe (Type vt at)
forall (f :: * -> *) v a.
(Var v, Show v, forall a1. Eq a1 => Eq (f a1),
 forall a1. Show a1 => Show (f a1), Traversable f) =>
Term f v a -> Term f v a -> Term f v a -> Maybe (Term f v a)
ABT.rewriteExpression Type vt at
tyLhs Type vt at
tyRhs Type vt at
tp
    go Term2 vt at ap v a
_ = Maybe (Term2 vt at ap v a)
forall a. Maybe a
Nothing

-- Used to rewrite cases of a `match` (`@rewrite case` rules)
-- Implementation is tricky - we convert the term to a form
-- which lets us use `ABT.rewriteExpression` to do the heavy lifting,
-- then convert the results back to a "regular" term after.
rewriteCasesLHS ::
  forall v typeVar typeAnn a.
  (Var v, Var typeVar, Ord v, Show typeVar, Eq typeAnn, Semigroup a) =>
  Term2 typeVar typeAnn a v a ->
  Term2 typeVar typeAnn a v a ->
  Term2 typeVar typeAnn a v a ->
  Maybe (Term2 typeVar typeAnn a v a)
rewriteCasesLHS :: forall v typeVar typeAnn a.
(Var v, Var typeVar, Ord v, Show typeVar, Eq typeAnn,
 Semigroup a) =>
Term2 typeVar typeAnn a v a
-> Term2 typeVar typeAnn a v a
-> Term2 typeVar typeAnn a v a
-> Maybe (Term2 typeVar typeAnn a v a)
rewriteCasesLHS Term2 typeVar typeAnn a v a
pat0 Term2 typeVar typeAnn a v a
pat0' =
  (\Term2 typeVar typeAnn a v a
tm -> Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a
out (Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a)
-> Maybe (Term2 typeVar typeAnn a v a)
-> Maybe (Term2 typeVar typeAnn a v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term2 typeVar typeAnn a v a
-> Term2 typeVar typeAnn a v a
-> Term2 typeVar typeAnn a v a
-> Maybe (Term2 typeVar typeAnn a v a)
forall (f :: * -> *) v a.
(Var v, Show v, forall a1. Eq a1 => Eq (f a1),
 forall a1. Show a1 => Show (f a1), Traversable f) =>
Term f v a -> Term f v a -> Term f v a -> Maybe (Term f v a)
ABT.rewriteExpression Term2 typeVar typeAnn a v a
pat Term2 typeVar typeAnn a v a
pat' (Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a
into Term2 typeVar typeAnn a v a
tm))
  where
    ann :: Term f v a -> a
ann = Term f v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation
    embedPattern :: Term (F vt at ap) v a -> Term (F vt at ap) v a
embedPattern Term (F vt at ap) v a
t = a
-> Term (F vt at ap) v a
-> Term (F vt at ap) v a
-> Term (F vt at ap) 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
app (Term (F vt at ap) v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ann Term (F vt at ap) v a
t) (a -> Text -> Term (F vt at ap) v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin (Term (F vt at ap) v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ann Term (F vt at ap) v a
t) Text
"#pattern") Term (F vt at ap) v a
t
    pat :: Term2 typeVar typeAnn a v a
pat = (Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a)
-> Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a
forall v (f :: * -> *) a.
(Ord v, Foldable f, Functor f) =>
(Term f v a -> Term f v a) -> Term f v a -> Term f v a
ABT.rebuildUp' Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a
forall {v} {vt} {at} {ap} {a}.
Ord v =>
Term (F vt at ap) v a -> Term (F vt at ap) v a
embedPattern Term2 typeVar typeAnn a v a
pat0
    pat' :: Term2 typeVar typeAnn a v a
pat' = Term2 typeVar typeAnn a v a
pat0'

    into :: Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a
    into :: Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a
into = (Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a)
-> Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a
forall v (f :: * -> *) a.
(Ord v, Foldable f, Functor f) =>
(Term f v a -> Term f v a) -> Term f v a -> Term f v a
ABT.rebuildUp' Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a
forall {v} {a} {vt} {at}.
(Ord v, Semigroup a) =>
Term (F vt at a) v a -> Term (F vt at a) v a
go
      where
        go :: Term (F vt at a) v a -> Term (F vt at a) v a
go t :: Term (F vt at a) v a
t@(Match' Term (F vt at a) v a
scrutinee [MatchCase a (Term (F vt at a) v a)]
cases) =
          Term (F vt at a) v a
-> [Term (F vt at a) v a] -> Term (F vt at 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 -> Text -> Term (F vt at a) v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin a
at Text
"#match") [Term (F vt at a) v a
scrutinee, Term (F vt at a) v a
-> [Term (F vt at a) v a] -> Term (F vt at 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 -> Text -> Term (F vt at a) v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin a
at Text
"#cases") ((MatchCase a (Term (F vt at a) v a) -> Term (F vt at a) v a)
-> [MatchCase a (Term (F vt at a) v a)] -> [Term (F vt at a) v a]
forall a b. (a -> b) -> [a] -> [b]
map MatchCase a (Term (F vt at a) v a) -> Term (F vt at a) v a
forall a v typeVar typeAnn.
(Semigroup a, Ord v) =>
MatchCase a (Term2 typeVar typeAnn a v a)
-> Term2 typeVar typeAnn a v a
matchCaseToTerm [MatchCase a (Term (F vt at a) v a)]
cases)]
          where
            at :: a
at = Term (F vt at a) v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ann Term (F vt at a) v a
t
        go Term (F vt at a) v a
t = Term (F vt at a) v a
t

    out :: Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a
    out :: Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a
out = (Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a)
-> Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a
forall v (f :: * -> *) a.
(Ord v, Foldable f, Functor f) =>
(Term f v a -> Term f v a) -> Term f v a -> Term f v a
ABT.rebuildUp' Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a
forall {v} {typeVar} {typeAnn} {a}.
Var v =>
Term (F typeVar typeAnn a) v a -> Term (F typeVar typeAnn a) v a
go
      where
        go :: Term (F typeVar typeAnn a) v a -> Term (F typeVar typeAnn a) v a
go (App' (Builtin' Text
"#pattern") Term (F typeVar typeAnn a) v a
t) = Term (F typeVar typeAnn a) v a
t
        go t :: Term (F typeVar typeAnn a) v a
t@(Apps' (Builtin' Text
"#match") [Term (F typeVar typeAnn a) v a
scrute, Apps' (Builtin' Text
"#cases") [Term (F typeVar typeAnn a) v a]
cases]) =
          a
-> Term (F typeVar typeAnn a) v a
-> [MatchCase a (Term (F typeVar typeAnn a) v a)]
-> Term (F typeVar typeAnn a) 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
at Term (F typeVar typeAnn a) v a
scrute (Maybe (MatchCase a (Term (F typeVar typeAnn a) v a))
-> MatchCase a (Term (F typeVar typeAnn a) v a)
tweak (Maybe (MatchCase a (Term (F typeVar typeAnn a) v a))
 -> MatchCase a (Term (F typeVar typeAnn a) v a))
-> (Term (F typeVar typeAnn a) v a
    -> Maybe (MatchCase a (Term (F typeVar typeAnn a) v a)))
-> Term (F typeVar typeAnn a) v a
-> MatchCase a (Term (F typeVar typeAnn a) v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term (F typeVar typeAnn a) v a
-> Maybe (MatchCase a (Term (F typeVar typeAnn a) v a))
forall v typeVar typeAnn a.
Var v =>
Term2 typeVar typeAnn a v a
-> Maybe (MatchCase a (Term2 typeVar typeAnn a v a))
matchCaseFromTerm (Term (F typeVar typeAnn a) v a
 -> MatchCase a (Term (F typeVar typeAnn a) v a))
-> [Term (F typeVar typeAnn a) v a]
-> [MatchCase a (Term (F typeVar typeAnn a) v a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Term (F typeVar typeAnn a) v a]
cases)
          where
            at :: a
at = Term (F typeVar typeAnn a) v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term (F typeVar typeAnn a) v a
t
            tweak :: Maybe (MatchCase a (Term (F typeVar typeAnn a) v a))
-> MatchCase a (Term (F typeVar typeAnn a) v a)
tweak Maybe (MatchCase a (Term (F typeVar typeAnn a) v a))
Nothing = Pattern a
-> Maybe (Term (F typeVar typeAnn a) v a)
-> Term (F typeVar typeAnn a) v a
-> MatchCase a (Term (F typeVar typeAnn a) v a)
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
MatchCase (a -> Pattern a
forall loc. loc -> Pattern loc
Pattern.Unbound a
at) Maybe (Term (F typeVar typeAnn a) v a)
forall a. Maybe a
Nothing (a -> Text -> Term (F typeVar typeAnn a) v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
text a
at Text
"🆘 rewrite produced an invalid pattern")
            tweak (Just MatchCase a (Term (F typeVar typeAnn a) v a)
mc) = MatchCase a (Term (F typeVar typeAnn a) v a)
mc
        go Term (F typeVar typeAnn a) v a
t = Term (F typeVar typeAnn a) v a
t

-- Implementation detail of `@rewrite case` rules (both find and replace)
toPattern :: (Var v) => Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern :: forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern Term2 tv ta tb v loc
tm = case Term2 tv ta tb v loc
tm of
  Var' v
v | Text
"_" Text -> Text -> Bool
`Text.isPrefixOf` v -> Text
forall v. Var v => v -> Text
Var.name v
v -> Pattern loc -> Maybe (Pattern loc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern loc -> Maybe (Pattern loc))
-> Pattern loc -> Maybe (Pattern loc)
forall a b. (a -> b) -> a -> b
$ loc -> Pattern loc
forall loc. loc -> Pattern loc
Pattern.Unbound loc
loc
  Var' v
_ -> Pattern loc -> Maybe (Pattern loc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern loc -> Maybe (Pattern loc))
-> Pattern loc -> Maybe (Pattern loc)
forall a b. (a -> b) -> a -> b
$ loc -> Pattern loc
forall loc. loc -> Pattern loc
Pattern.Var loc
loc
  Apps' (Builtin' Text
"#as") [Var' v
_, Term2 tv ta tb v loc
tm] -> loc -> Pattern loc -> Pattern loc
forall loc. loc -> Pattern loc -> Pattern loc
Pattern.As loc
loc (Pattern loc -> Pattern loc)
-> Maybe (Pattern loc) -> Maybe (Pattern loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term2 tv ta tb v loc -> Maybe (Pattern loc)
forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern Term2 tv ta tb v loc
tm
  App' (Builtin' Text
"#effect-pure") Term2 tv ta tb v loc
p -> loc -> Pattern loc -> Pattern loc
forall loc. loc -> Pattern loc -> Pattern loc
Pattern.EffectPure loc
loc (Pattern loc -> Pattern loc)
-> Maybe (Pattern loc) -> Maybe (Pattern loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term2 tv ta tb v loc -> Maybe (Pattern loc)
forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern Term2 tv ta tb v loc
p
  Apps' (Builtin' Text
"#effect-bind") [Apps' (Request' ConstructorReference
r) [Term2 tv ta tb v loc]
args, Term2 tv ta tb v loc
k] ->
    loc
-> ConstructorReference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
forall loc.
loc
-> ConstructorReference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
Pattern.EffectBind loc
loc ConstructorReference
r ([Pattern loc] -> Pattern loc -> Pattern loc)
-> Maybe [Pattern loc] -> Maybe (Pattern loc -> Pattern loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term2 tv ta tb v loc -> Maybe (Pattern loc))
-> [Term2 tv ta tb v loc] -> Maybe [Pattern loc]
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 Term2 tv ta tb v loc -> Maybe (Pattern loc)
forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern [Term2 tv ta tb v loc]
args Maybe (Pattern loc -> Pattern loc)
-> Maybe (Pattern loc) -> Maybe (Pattern loc)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term2 tv ta tb v loc -> Maybe (Pattern loc)
forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern Term2 tv ta tb v loc
k
  Apps' (Request' ConstructorReference
r) [Term2 tv ta tb v loc]
args -> loc
-> ConstructorReference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
forall loc.
loc
-> ConstructorReference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
Pattern.EffectBind loc
loc ConstructorReference
r ([Pattern loc] -> Pattern loc -> Pattern loc)
-> Maybe [Pattern loc] -> Maybe (Pattern loc -> Pattern loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term2 tv ta tb v loc -> Maybe (Pattern loc))
-> [Term2 tv ta tb v loc] -> Maybe [Pattern loc]
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 Term2 tv ta tb v loc -> Maybe (Pattern loc)
forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern [Term2 tv ta tb v loc]
args Maybe (Pattern loc -> Pattern loc)
-> Maybe (Pattern loc) -> Maybe (Pattern loc)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern loc -> Maybe (Pattern loc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (loc -> Pattern loc
forall loc. loc -> Pattern loc
Pattern.Unbound loc
loc)
  Apps' (Constructor' ConstructorReference
r) [Term2 tv ta tb v loc]
args -> loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
forall loc.
loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
Pattern.Constructor loc
loc ConstructorReference
r ([Pattern loc] -> Pattern loc)
-> Maybe [Pattern loc] -> Maybe (Pattern loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term2 tv ta tb v loc -> Maybe (Pattern loc))
-> [Term2 tv ta tb v loc] -> Maybe [Pattern loc]
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 Term2 tv ta tb v loc -> Maybe (Pattern loc)
forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern [Term2 tv ta tb v loc]
args
  Constructor' ConstructorReference
r -> Pattern loc -> Maybe (Pattern loc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern loc -> Maybe (Pattern loc))
-> Pattern loc -> Maybe (Pattern loc)
forall a b. (a -> b) -> a -> b
$ loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
forall loc.
loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
Pattern.Constructor loc
loc ConstructorReference
r []
  Request' ConstructorReference
r -> Pattern loc -> Maybe (Pattern loc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern loc -> Maybe (Pattern loc))
-> Pattern loc -> Maybe (Pattern loc)
forall a b. (a -> b) -> a -> b
$ loc
-> ConstructorReference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
forall loc.
loc
-> ConstructorReference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
Pattern.EffectBind loc
loc ConstructorReference
r [] (loc -> Pattern loc
forall loc. loc -> Pattern loc
Pattern.Unbound loc
loc)
  Int' Int64
i -> Pattern loc -> Maybe (Pattern loc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern loc -> Maybe (Pattern loc))
-> Pattern loc -> Maybe (Pattern loc)
forall a b. (a -> b) -> a -> b
$ loc -> Int64 -> Pattern loc
forall loc. loc -> Int64 -> Pattern loc
Pattern.Int loc
loc Int64
i
  Nat' Word64
n -> Pattern loc -> Maybe (Pattern loc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern loc -> Maybe (Pattern loc))
-> Pattern loc -> Maybe (Pattern loc)
forall a b. (a -> b) -> a -> b
$ loc -> Word64 -> Pattern loc
forall loc. loc -> Word64 -> Pattern loc
Pattern.Nat loc
loc Word64
n
  Float' Double
f -> Pattern loc -> Maybe (Pattern loc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern loc -> Maybe (Pattern loc))
-> Pattern loc -> Maybe (Pattern loc)
forall a b. (a -> b) -> a -> b
$ loc -> Double -> Pattern loc
forall loc. loc -> Double -> Pattern loc
Pattern.Float loc
loc Double
f
  Boolean' Bool
b -> Pattern loc -> Maybe (Pattern loc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern loc -> Maybe (Pattern loc))
-> Pattern loc -> Maybe (Pattern loc)
forall a b. (a -> b) -> a -> b
$ loc -> Bool -> Pattern loc
forall loc. loc -> Bool -> Pattern loc
Pattern.Boolean loc
loc Bool
b
  Text' Text
t -> Pattern loc -> Maybe (Pattern loc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern loc -> Maybe (Pattern loc))
-> Pattern loc -> Maybe (Pattern loc)
forall a b. (a -> b) -> a -> b
$ loc -> Text -> Pattern loc
forall loc. loc -> Text -> Pattern loc
Pattern.Text loc
loc Text
t
  Char' Char
c -> Pattern loc -> Maybe (Pattern loc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern loc -> Maybe (Pattern loc))
-> Pattern loc -> Maybe (Pattern loc)
forall a b. (a -> b) -> a -> b
$ loc -> Char -> Pattern loc
forall loc. loc -> Char -> Pattern loc
Pattern.Char loc
loc Char
c
  Blank' Blank ta
_ -> Pattern loc -> Maybe (Pattern loc)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern loc -> Maybe (Pattern loc))
-> Pattern loc -> Maybe (Pattern loc)
forall a b. (a -> b) -> a -> b
$ loc -> Pattern loc
forall loc. loc -> Pattern loc
Pattern.Unbound loc
loc
  List' Seq (Term2 tv ta tb v loc)
xs -> loc -> [Pattern loc] -> Pattern loc
forall loc. loc -> [Pattern loc] -> Pattern loc
Pattern.SequenceLiteral loc
loc ([Pattern loc] -> Pattern loc)
-> Maybe [Pattern loc] -> Maybe (Pattern loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term2 tv ta tb v loc -> Maybe (Pattern loc))
-> [Term2 tv ta tb v loc] -> Maybe [Pattern loc]
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 Term2 tv ta tb v loc -> Maybe (Pattern loc)
forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern (Seq (Term2 tv ta tb v loc) -> [Term2 tv ta tb v loc]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Term2 tv ta tb v loc)
xs)
  Apps' (Builtin' Text
"List.cons") [Term2 tv ta tb v loc
a, Term2 tv ta tb v loc
b] -> loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
forall loc.
loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
Pattern.SequenceOp loc
loc (Pattern loc -> SeqOp -> Pattern loc -> Pattern loc)
-> Maybe (Pattern loc)
-> Maybe (SeqOp -> Pattern loc -> Pattern loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term2 tv ta tb v loc -> Maybe (Pattern loc)
forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern Term2 tv ta tb v loc
a Maybe (SeqOp -> Pattern loc -> Pattern loc)
-> Maybe SeqOp -> Maybe (Pattern loc -> Pattern loc)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SeqOp -> Maybe SeqOp
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SeqOp
Pattern.Cons Maybe (Pattern loc -> Pattern loc)
-> Maybe (Pattern loc) -> Maybe (Pattern loc)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term2 tv ta tb v loc -> Maybe (Pattern loc)
forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern Term2 tv ta tb v loc
b
  Apps' (Builtin' Text
"List.snoc") [Term2 tv ta tb v loc
a, Term2 tv ta tb v loc
b] -> loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
forall loc.
loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
Pattern.SequenceOp loc
loc (Pattern loc -> SeqOp -> Pattern loc -> Pattern loc)
-> Maybe (Pattern loc)
-> Maybe (SeqOp -> Pattern loc -> Pattern loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term2 tv ta tb v loc -> Maybe (Pattern loc)
forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern Term2 tv ta tb v loc
a Maybe (SeqOp -> Pattern loc -> Pattern loc)
-> Maybe SeqOp -> Maybe (Pattern loc -> Pattern loc)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SeqOp -> Maybe SeqOp
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SeqOp
Pattern.Snoc Maybe (Pattern loc -> Pattern loc)
-> Maybe (Pattern loc) -> Maybe (Pattern loc)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term2 tv ta tb v loc -> Maybe (Pattern loc)
forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern Term2 tv ta tb v loc
b
  Apps' (Builtin' Text
"List.++") [Term2 tv ta tb v loc
a, Term2 tv ta tb v loc
b] -> loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
forall loc.
loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
Pattern.SequenceOp loc
loc (Pattern loc -> SeqOp -> Pattern loc -> Pattern loc)
-> Maybe (Pattern loc)
-> Maybe (SeqOp -> Pattern loc -> Pattern loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term2 tv ta tb v loc -> Maybe (Pattern loc)
forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern Term2 tv ta tb v loc
a Maybe (SeqOp -> Pattern loc -> Pattern loc)
-> Maybe SeqOp -> Maybe (Pattern loc -> Pattern loc)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SeqOp -> Maybe SeqOp
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SeqOp
Pattern.Concat Maybe (Pattern loc -> Pattern loc)
-> Maybe (Pattern loc) -> Maybe (Pattern loc)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term2 tv ta tb v loc -> Maybe (Pattern loc)
forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern Term2 tv ta tb v loc
b
  Term2 tv ta tb v loc
_ -> Maybe (Pattern loc)
forall a. Maybe a
Nothing
  where
    loc :: loc
loc = Term2 tv ta tb v loc -> loc
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term2 tv ta tb v loc
tm

-- Implementation detail of `@rewrite case` rules (both find and replace)
matchCaseFromTerm :: (Var v) => Term2 typeVar typeAnn a v a -> Maybe (MatchCase a (Term2 typeVar typeAnn a v a))
matchCaseFromTerm :: forall v typeVar typeAnn a.
Var v =>
Term2 typeVar typeAnn a v a
-> Maybe (MatchCase a (Term2 typeVar typeAnn a v a))
matchCaseFromTerm (App' (Builtin' Text
"#case") (Term (F typeVar typeAnn a) v a
-> ([(a, v)], Term (F typeVar typeAnn a) v a)
forall (f :: * -> *) v a. Term f v a -> ([(a, v)], Term f v a)
ABT.unabsA -> ([(a, v)]
_, Apps' Term (F typeVar typeAnn a) v a
_ci [Term (F typeVar typeAnn a) v a
pat, Term (F typeVar typeAnn a) v a
guard, Term (F typeVar typeAnn a) v a
body]))) = do
  Pattern a
p <- Term (F typeVar typeAnn a) v a -> Maybe (Pattern a)
forall v tv ta tb loc.
Var v =>
Term2 tv ta tb v loc -> Maybe (Pattern loc)
toPattern Term (F typeVar typeAnn a) v a
pat
  let g :: Maybe (Term (F typeVar typeAnn a) v a)
g = Term (F typeVar typeAnn a) v a
-> Maybe (Term (F typeVar typeAnn a) v a)
forall {typeVar} {typeAnn} {patternAnn} {v} {a}.
Term (F typeVar typeAnn patternAnn) v a
-> Maybe (Term (F typeVar typeAnn patternAnn) v a)
unguard Term (F typeVar typeAnn a) v a
guard
  MatchCase a (Term (F typeVar typeAnn a) v a)
-> Maybe (MatchCase a (Term (F typeVar typeAnn a) v a))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MatchCase a (Term (F typeVar typeAnn a) v a)
 -> Maybe (MatchCase a (Term (F typeVar typeAnn a) v a)))
-> MatchCase a (Term (F typeVar typeAnn a) v a)
-> Maybe (MatchCase a (Term (F typeVar typeAnn a) v a))
forall a b. (a -> b) -> a -> b
$ Pattern a
-> Maybe (Term (F typeVar typeAnn a) v a)
-> Term (F typeVar typeAnn a) v a
-> MatchCase a (Term (F typeVar typeAnn a) v a)
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
MatchCase Pattern a
p (Term (F typeVar typeAnn a) v a
-> Term (F typeVar typeAnn a) v a -> Term (F typeVar typeAnn a) v a
forall {v} {f :: * -> *} {a} {f :: * -> *} {a}.
(Ord v, Foldable f) =>
Term f v a -> Term f v a -> Term f v a
rechain Term (F typeVar typeAnn a) v a
pat (Term (F typeVar typeAnn a) v a -> Term (F typeVar typeAnn a) v a)
-> Maybe (Term (F typeVar typeAnn a) v a)
-> Maybe (Term (F typeVar typeAnn a) v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Term (F typeVar typeAnn a) v a)
g) (Term (F typeVar typeAnn a) v a
-> Term (F typeVar typeAnn a) v a -> Term (F typeVar typeAnn a) v a
forall {v} {f :: * -> *} {a} {f :: * -> *} {a}.
(Ord v, Foldable f) =>
Term f v a -> Term f v a -> Term f v a
rechain Term (F typeVar typeAnn a) v a
pat Term (F typeVar typeAnn a) v a
body)
  where
    unguard :: Term (F typeVar typeAnn patternAnn) v a
-> Maybe (Term (F typeVar typeAnn patternAnn) v a)
unguard (App' (Builtin' Text
"#guard") Term (F typeVar typeAnn patternAnn) v a
t) = Term (F typeVar typeAnn patternAnn) v a
-> Maybe (Term (F typeVar typeAnn patternAnn) v a)
forall a. a -> Maybe a
Just Term (F typeVar typeAnn patternAnn) v a
t
    unguard (Builtin' Text
"#noguard") = Maybe (Term (F typeVar typeAnn patternAnn) v a)
forall a. Maybe a
Nothing
    unguard Term (F typeVar typeAnn patternAnn) v a
_ = Maybe (Term (F typeVar typeAnn patternAnn) v a)
forall a. Maybe a
Nothing
    rechain :: Term f v a -> Term f v a -> Term f v a
rechain Term f v a
pat Term f v a
tm = (v -> Term f v a -> Term f v a) -> Term f v a -> [v] -> Term f v a
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 Term f v a
tm -> a -> v -> Term f v a -> Term f v a
forall v a (f :: * -> *).
Ord v =>
a -> v -> Term f v a -> Term f v a
ABT.abs' (Term f v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term f v a
tm) v
v Term f v a
tm) Term f v a
tm (Term f v a -> [v]
forall (f :: * -> *) v a. Foldable f => Term f v a -> [v]
ABT.allVars Term f v a
pat)
matchCaseFromTerm Term (F typeVar typeAnn a) v a
t =
  MatchCase a (Term (F typeVar typeAnn a) v a)
-> Maybe (MatchCase a (Term (F typeVar typeAnn a) v a))
forall a. a -> Maybe a
Just (Pattern a
-> Maybe (Term (F typeVar typeAnn a) v a)
-> Term (F typeVar typeAnn a) v a
-> MatchCase a (Term (F typeVar typeAnn a) v a)
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
MatchCase (a -> Pattern a
forall loc. loc -> Pattern loc
Pattern.Unbound (Term (F typeVar typeAnn a) v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term (F typeVar typeAnn a) v a
t)) Maybe (Term (F typeVar typeAnn a) v a)
forall a. Maybe a
Nothing (a -> Text -> Term (F typeVar typeAnn a) v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
text (Term (F typeVar typeAnn a) v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term (F typeVar typeAnn a) v a
t) Text
"💥 bug: matchCaseToTerm"))

-- Implementation detail of `@rewrite case` rules (both find and replace)
matchCaseToTerm :: (Semigroup a, Ord v) => MatchCase a (Term2 typeVar typeAnn a v a) -> Term2 typeVar typeAnn a v a
matchCaseToTerm :: forall a v typeVar typeAnn.
(Semigroup a, Ord v) =>
MatchCase a (Term2 typeVar typeAnn a v a)
-> Term2 typeVar typeAnn a v a
matchCaseToTerm (MatchCase Pattern a
pat Maybe (Term2 typeVar typeAnn a v a)
guard (Term2 typeVar typeAnn a v a
-> ([(a, v)], Term2 typeVar typeAnn a v a)
forall (f :: * -> *) v a. Term f v a -> ([(a, v)], Term f v a)
ABT.unabsA -> ([(a, v)]
avs, Term2 typeVar typeAnn a v a
body))) =
  a
-> Term2 typeVar typeAnn a v a
-> Term2 typeVar typeAnn a v a
-> Term2 typeVar typeAnn a 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
app a
loc0 (a -> Text -> Term2 typeVar typeAnn a v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin a
loc0 Text
"#case") Term2 typeVar typeAnn a v a
chain
  where
    loc0 :: a
loc0 = Pattern a -> a
forall loc. Pattern loc -> loc
Pattern.loc Pattern a
pat
    chain :: Term2 typeVar typeAnn a v a
chain = [(a, v)]
-> Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a
forall v a (f :: * -> *).
Ord v =>
[(a, v)] -> Term f v a -> Term f v a
ABT.absChain' [(a, v)]
avs (Term2 typeVar typeAnn a v a
-> [Term2 typeVar typeAnn a v a] -> Term2 typeVar typeAnn 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' Term2 typeVar typeAnn a v a
ci [State [(a, v)] (Term2 typeVar typeAnn a v a)
-> [(a, v)] -> Term2 typeVar typeAnn a v a
forall s a. State s a -> s -> a
evalState (Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a
forall {v} {vt} {at} {ap} {a}.
Ord v =>
Term (F vt at ap) v a -> Term (F vt at ap) v a
embedPattern (Term2 typeVar typeAnn a v a -> Term2 typeVar typeAnn a v a)
-> State [(a, v)] (Term2 typeVar typeAnn a v a)
-> State [(a, v)] (Term2 typeVar typeAnn a v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a -> State [(a, v)] (Term2 typeVar typeAnn a v a)
forall {f :: * -> *} {v} {a} {vt} {at} {ap}.
(Ord v, MonadState [(a, v)] f, Semigroup a) =>
Pattern a -> f (Term2 vt at ap v a)
intop Pattern a
pat) [(a, v)]
avs, Maybe (Term2 typeVar typeAnn a v a) -> Term2 typeVar typeAnn a v a
intog Maybe (Term2 typeVar typeAnn a v a)
guard, Term2 typeVar typeAnn a v a
body])
      where
        ci :: Term2 typeVar typeAnn a v a
ci = a -> Text -> Term2 typeVar typeAnn a v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin a
loc0 Text
"#case.inner"
        intog :: Maybe (Term2 typeVar typeAnn a v a) -> Term2 typeVar typeAnn a v a
intog Maybe (Term2 typeVar typeAnn a v a)
Nothing = a -> Text -> Term2 typeVar typeAnn a v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin a
loc0 Text
"#noguard"
        intog (Just (Term2 typeVar typeAnn a v a
-> ([(a, v)], Term2 typeVar typeAnn a v a)
forall (f :: * -> *) v a. Term f v a -> ([(a, v)], Term f v a)
ABT.unabsA -> ([(a, v)]
_, Term2 typeVar typeAnn a v a
t))) = a
-> Term2 typeVar typeAnn a v a
-> Term2 typeVar typeAnn a v a
-> Term2 typeVar typeAnn a 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
app (Term2 typeVar typeAnn a v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term2 typeVar typeAnn a v a
t) (a -> Text -> Term2 typeVar typeAnn a v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin (Term2 typeVar typeAnn a v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term2 typeVar typeAnn a v a
t) Text
"#guard") Term2 typeVar typeAnn a v a
t

    embedPattern :: Term (F vt at ap) v a -> Term (F vt at ap) v a
embedPattern Term (F vt at ap) v a
t = (Term (F vt at ap) v a -> Term (F vt at ap) v a)
-> Term (F vt at ap) v a -> Term (F vt at ap) v a
forall v (f :: * -> *) a.
(Ord v, Foldable f, Functor f) =>
(Term f v a -> Term f v a) -> Term f v a -> Term f v a
ABT.rebuildUp' Term (F vt at ap) v a -> Term (F vt at ap) v a
forall {v} {vt} {at} {ap} {a}.
Ord v =>
Term (F vt at ap) v a -> Term (F vt at ap) v a
embed Term (F vt at ap) v a
t
      where
        embed :: Term (F vt at ap) v a -> Term (F vt at ap) v a
embed Term (F vt at ap) v a
t = a
-> Term (F vt at ap) v a
-> Term (F vt at ap) v a
-> Term (F vt at ap) 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
app (Term (F vt at ap) v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term (F vt at ap) v a
t) (a -> Text -> Term (F vt at ap) v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin (Term (F vt at ap) v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term (F vt at ap) v a
t) Text
"#pattern") Term (F vt at ap) v a
t
    intop :: Pattern a -> f (Term2 vt at ap v a)
intop Pattern a
pat = case Pattern a
pat of
      Pattern.Unbound a
loc -> Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Term2 vt at ap v a
blank a
loc)
      Pattern.Var a
loc -> do
        [(a, v)]
avs <- f [(a, v)]
forall s (m :: * -> *). MonadState s m => m s
State.get
        case [(a, v)]
avs of
          (a
a, v
v) : [(a, v)]
avs -> [(a, v)] -> f ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put [(a, v)]
avs f () -> Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a -> v -> Term2 vt at ap v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
a v
v
          [(a, v)]
_ -> Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Term2 vt at ap v a
blank a
loc)
      Pattern.Boolean a
loc Bool
b -> Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Bool -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Bool -> Term2 vt at ap v a
boolean a
loc Bool
b)
      Pattern.Int a
loc Int64
i -> Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Int64 -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Int64 -> Term2 vt at ap v a
int a
loc Int64
i)
      Pattern.Nat a
loc Word64
n -> Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Word64 -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Word64 -> Term2 vt at ap v a
nat a
loc Word64
n)
      Pattern.Float a
loc Double
f -> Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Double -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Double -> Term2 vt at ap v a
float a
loc Double
f)
      Pattern.Text a
loc Text
t -> Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Text -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
text a
loc Text
t)
      Pattern.Char a
loc Char
c -> Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Char -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Char -> Term2 vt at ap v a
char a
loc Char
c)
      Pattern.Constructor a
loc ConstructorReference
r [Pattern a]
ps -> 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 -> ConstructorReference -> Term2 vt at ap v a
forall v a vt at ap.
Ord v =>
a -> ConstructorReference -> Term2 vt at ap v a
constructor a
loc ConstructorReference
r) ([Term2 vt at ap v a] -> Term2 vt at ap v a)
-> f [Term2 vt at ap v a] -> f (Term2 vt at ap v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern a -> f (Term2 vt at ap v a))
-> [Pattern a] -> f [Term2 vt at ap 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 Pattern a -> f (Term2 vt at ap v a)
intop [Pattern a]
ps
      Pattern.As a
loc Pattern a
p -> do
        [(a, v)]
avs <- f [(a, v)]
forall s (m :: * -> *). MonadState s m => m s
State.get
        case [(a, v)]
avs of
          (a
a, v
v) : [(a, v)]
avs -> do
            [(a, v)] -> f ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put [(a, v)]
avs
            Term2 vt at ap v a
p <- Pattern a -> f (Term2 vt at ap v a)
intop Pattern a
p
            Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term2 vt at ap v a -> f (Term2 vt at ap v a))
-> Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall a b. (a -> b) -> a -> b
$ 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 -> Text -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin a
loc Text
"#as") [a -> v -> Term2 vt at ap v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
a v
v, Term2 vt at ap v a
p]
          [(a, v)]
_ -> Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Term2 vt at ap v a
blank a
loc)
      Pattern.EffectPure a
loc Pattern a
p -> a -> 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 =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
app a
loc (a -> Text -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin a
loc Text
"#effect-pure") (Term2 vt at ap v a -> Term2 vt at ap v a)
-> f (Term2 vt at ap v a) -> f (Term2 vt at ap v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a -> f (Term2 vt at ap v a)
intop Pattern a
p
      Pattern.EffectBind a
loc ConstructorReference
r [Pattern a]
ps Pattern a
k -> do
        [Term2 vt at ap v a]
ps <- (Pattern a -> f (Term2 vt at ap v a))
-> [Pattern a] -> f [Term2 vt at ap 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 Pattern a -> f (Term2 vt at ap v a)
intop [Pattern a]
ps
        Term2 vt at ap v a
k <- Pattern a -> f (Term2 vt at ap v a)
intop Pattern a
k
        Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term2 vt at ap v a -> f (Term2 vt at ap v a))
-> Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall a b. (a -> b) -> a -> b
$ 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 -> Text -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin a
loc Text
"#effect-bind") [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 -> ConstructorReference -> Term2 vt at ap v a
forall v a vt at ap.
Ord v =>
a -> ConstructorReference -> Term2 vt at ap v a
request a
loc ConstructorReference
r) [Term2 vt at ap v a]
ps, Term2 vt at ap v a
k]
      Pattern.SequenceLiteral a
loc [Pattern a]
ps -> a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
list a
loc ([Term2 vt at ap v a] -> Term2 vt at ap v a)
-> f [Term2 vt at ap v a] -> f (Term2 vt at ap v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern a -> f (Term2 vt at ap v a))
-> [Pattern a] -> f [Term2 vt at ap 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 Pattern a -> f (Term2 vt at ap v a)
intop [Pattern a]
ps
      Pattern.SequenceOp a
loc Pattern a
p SeqOp
op Pattern a
q -> do
        Term2 vt at ap v a
p <- Pattern a -> f (Term2 vt at ap v a)
intop Pattern a
p
        Term2 vt at ap v a
q <- Pattern a -> f (Term2 vt at ap v a)
intop Pattern a
q
        Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term2 vt at ap v a -> f (Term2 vt at ap v a))
-> Term2 vt at ap v a -> f (Term2 vt at ap v a)
forall a b. (a -> b) -> a -> b
$ 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' (SeqOp -> Term2 vt at ap v a
intoOp SeqOp
op) [Term2 vt at ap v a
p, Term2 vt at ap v a
q]
        where
          intoOp :: SeqOp -> Term2 vt at ap v a
intoOp SeqOp
Pattern.Concat = a -> Text -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin a
loc Text
"List.++"
          intoOp SeqOp
Pattern.Snoc = a -> Text -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin a
loc Text
"List.snoc"
          intoOp SeqOp
Pattern.Cons = a -> Text -> Term2 vt at ap v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin a
loc Text
"List.cons"

-- mostly boring serialization code below ...

instance (ABT.Var vt, Eq at, Eq a) => Eq (F vt at p a) where
  Int Int64
x == :: F vt at p a -> F vt at p a -> Bool
== Int Int64
y = Int64
x Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
y
  Nat Word64
x == Nat Word64
y = Word64
x Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
y
  Float Double
x == Float Double
y = Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
y
  Boolean Bool
x == Boolean Bool
y = Bool
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
y
  Text Text
x == Text Text
y = Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
y
  Char Char
x == Char Char
y = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
y
  Blank Blank at
b == Blank Blank at
q = Blank at
b Blank at -> Blank at -> Bool
forall a. Eq a => a -> a -> Bool
== Blank at
q
  Ref Reference
x == Ref Reference
y = Reference
x Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
y
  TermLink Referent
x == TermLink Referent
y = Referent
x Referent -> Referent -> Bool
forall a. Eq a => a -> a -> Bool
== Referent
y
  TypeLink Reference
x == TypeLink Reference
y = Reference
x Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
y
  Constructor ConstructorReference
r == Constructor ConstructorReference
r2 = ConstructorReference
r ConstructorReference -> ConstructorReference -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorReference
r2
  Request ConstructorReference
r == Request ConstructorReference
r2 = ConstructorReference
r ConstructorReference -> ConstructorReference -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorReference
r2
  Handle a
h a
b == Handle a
h2 a
b2 = a
h a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
h2 Bool -> Bool -> Bool
&& a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b2
  App a
f a
a == App a
f2 a
a2 = a
f a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
f2 Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a2
  Ann a
e Type vt at
t == Ann a
e2 Type vt at
t2 = a
e a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
e2 Bool -> Bool -> Bool
&& Type vt at
t Type vt at -> Type vt at -> Bool
forall a. Eq a => a -> a -> Bool
== Type vt at
t2
  List Seq a
v == List Seq a
v2 = Seq a
v Seq a -> Seq a -> Bool
forall a. Eq a => a -> a -> Bool
== Seq a
v2
  If a
a a
b a
c == If a
a2 a
b2 a
c2 = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a2 Bool -> Bool -> Bool
&& a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b2 Bool -> Bool -> Bool
&& a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c2
  And a
a a
b == And a
a2 a
b2 = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a2 Bool -> Bool -> Bool
&& a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b2
  Or a
a a
b == Or a
a2 a
b2 = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a2 Bool -> Bool -> Bool
&& a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b2
  Lam a
a == Lam a
b = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b
  LetRec Bool
_ [a]
bs a
body == LetRec Bool
_ [a]
bs2 a
body2 = [a]
bs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
bs2 Bool -> Bool -> Bool
&& a
body a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
body2
  Let Bool
_ a
binding a
body == Let Bool
_ a
binding2 a
body2 =
    a
binding a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
binding2 Bool -> Bool -> Bool
&& a
body a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
body2
  Match a
scrutinee [MatchCase p a]
cases == Match a
s2 [MatchCase p a]
cs2 = a
scrutinee a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
s2 Bool -> Bool -> Bool
&& [MatchCase p a]
cases [MatchCase p a] -> [MatchCase p a] -> Bool
forall a. Eq a => a -> a -> Bool
== [MatchCase p a]
cs2
  F vt at p a
_ == F vt at p a
_ = Bool
False

instance (Show v, Show a) => Show (F v a0 p a) where
  showsPrec :: Int -> F v a0 p a -> ShowS
showsPrec = Int -> F v a0 p a -> ShowS
forall {a} {a} {typeVar} {typeAnn} {patternAnn}.
(Ord a, Num a, Show a, Show typeVar) =>
a -> F typeVar typeAnn patternAnn a -> ShowS
go
    where
      go :: a -> F typeVar typeAnn patternAnn a -> ShowS
go a
_ (Int Int64
n) = (if Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0 then String -> ShowS
s String
"+" else String -> ShowS
s String
"") ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> Int64 -> ShowS
forall a. Show a => a -> ShowS
shows Int64
n
      go a
_ (Nat Word64
n) = Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
n
      go a
_ (Float Double
n) = Double -> ShowS
forall a. Show a => a -> ShowS
shows Double
n
      go a
_ (Boolean Bool
True) = String -> ShowS
s String
"true"
      go a
_ (Boolean Bool
False) = String -> ShowS
s String
"false"
      go a
p (Ann a
t Type typeVar typeAnn
k) = Bool -> ShowS -> ShowS
showParen (a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ a -> ShowS
forall a. Show a => a -> ShowS
shows a
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> String -> ShowS
s String
":" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> Type typeVar typeAnn -> ShowS
forall a. Show a => a -> ShowS
shows Type typeVar typeAnn
k
      go a
p (App a
f a
x) = Bool -> ShowS -> ShowS
showParen (a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
9) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
9 a
f ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> String -> ShowS
s String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 a
x
      go a
_ (Lam a
body) = Bool -> ShowS -> ShowS
showParen Bool
True (String -> ShowS
s String
"λ " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> a -> ShowS
forall a. Show a => a -> ShowS
shows a
body)
      go a
_ (List Seq a
vs) = (a -> ShowS) -> [a] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showListWith a -> ShowS
forall a. Show a => a -> ShowS
shows (Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
vs)
      go a
_ (Blank Blank typeAnn
b) = case Blank typeAnn
b of
        Blank typeAnn
B.Blank -> String -> ShowS
s String
"_"
        B.Recorded (B.Placeholder typeAnn
_ String
r) -> String -> ShowS
s (String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
r)
        B.Recorded (B.Resolve typeAnn
_ String
r) -> String -> ShowS
s String
r
        B.Recorded (B.MissingResultPlaceholder typeAnn
_) -> String -> ShowS
s String
"_"
        Blank typeAnn
B.Retain -> String -> ShowS
s String
"_"
      go a
_ (Ref Reference
r) = String -> ShowS
s String
"Ref(" 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
s String
")"
      go a
_ (TermLink Referent
r) = String -> ShowS
s String
"TermLink(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> Referent -> ShowS
forall a. Show a => a -> ShowS
shows Referent
r ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> String -> ShowS
s String
")"
      go a
_ (TypeLink Reference
r) = String -> ShowS
s String
"TypeLink(" 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
s String
")"
      go a
_ (Let Bool
_ a
b a
body) =
        Bool -> ShowS -> ShowS
showParen Bool
True (String -> ShowS
s String
"let " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> a -> ShowS
forall a. Show a => a -> ShowS
shows a
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> String -> ShowS
s String
" in " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> a -> ShowS
forall a. Show a => a -> ShowS
shows a
body)
      go a
_ (LetRec Bool
_ [a]
bs a
body) =
        Bool -> ShowS -> ShowS
showParen
          Bool
True
          (String -> ShowS
s String
"let rec" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> [a] -> ShowS
forall a. Show a => a -> ShowS
shows [a]
bs ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> String -> ShowS
s String
" in " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> a -> ShowS
forall a. Show a => a -> ShowS
shows a
body)
      go a
_ (Handle a
b a
body) =
        Bool -> ShowS -> ShowS
showParen
          Bool
True
          (String -> ShowS
s String
"handle " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> a -> ShowS
forall a. Show a => a -> ShowS
shows a
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> String -> ShowS
s String
" in " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> a -> ShowS
forall a. Show a => a -> ShowS
shows a
body)
      go a
_ (Constructor (ConstructorReference Reference
r Word64
n)) = String -> ShowS
s 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
s String
"#" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
n
      go a
_ (Match a
scrutinee [MatchCase patternAnn a]
cases) =
        Bool -> ShowS -> ShowS
showParen
          Bool
True
          (String -> ShowS
s String
"case " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> a -> ShowS
forall a. Show a => a -> ShowS
shows a
scrutinee ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> String -> ShowS
s String
" of " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> [MatchCase patternAnn a] -> ShowS
forall a. Show a => a -> ShowS
shows [MatchCase patternAnn a]
cases)
      go a
_ (Text Text
s) = Text -> ShowS
forall a. Show a => a -> ShowS
shows Text
s
      go a
_ (Char Char
c) = Char -> ShowS
forall a. Show a => a -> ShowS
shows Char
c
      go a
_ (Request (ConstructorReference Reference
r Word64
n)) = String -> ShowS
s 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
s String
"#" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
n
      go a
p (If a
c a
t a
f) =
        Bool -> ShowS -> ShowS
showParen (a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          String -> ShowS
s String
"if "
            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
s String
" then "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> a -> ShowS
forall a. Show a => a -> ShowS
shows a
t
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> String -> ShowS
s String
" else "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> a -> ShowS
forall a. Show a => a -> ShowS
shows a
f
      go a
p (And a
x a
y) =
        Bool -> ShowS -> ShowS
showParen (a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
s String
"and " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> a -> ShowS
forall a. Show a => a -> ShowS
shows a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> String -> ShowS
s String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> a -> ShowS
forall a. Show a => a -> ShowS
shows a
y
      go a
p (Or a
x a
y) =
        Bool -> ShowS -> ShowS
showParen (a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
s String
"or " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> a -> ShowS
forall a. Show a => a -> ShowS
shows a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> String -> ShowS
s String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
<> a -> ShowS
forall a. Show a => a -> ShowS
shows a
y
      <> :: (b -> c) -> (a -> b) -> a -> c
(<>) = (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
      s :: String -> ShowS
s = String -> ShowS
showString