-- | Base DSL which makes use of phantom types. Use this DSL for defining programs as opposed to data type definitions.

module Hydra.Dsl.Base (
  module Hydra.Dsl.Base,
  module Hydra.Dsl.PhantomLiterals,
  module Hydra.Dsl.ShorthandTypes,
  hydraCore,
) where

import Hydra.Coders
import Hydra.Core
import Hydra.Compute
import Hydra.Graph
import Hydra.Annotations
import Hydra.Phantoms
import Hydra.Module
import qualified Hydra.Tier1 as Tier1
import Hydra.Dsl.PhantomLiterals
import Hydra.Dsl.ShorthandTypes
import Hydra.Sources.Core
import qualified Hydra.Dsl.Terms as Terms
import qualified Hydra.Dsl.Types as Types
import qualified Hydra.Dsl.Lib.Lists as Lists
import Hydra.Sources.Libraries

import Prelude hiding ((++))
import Data.String(IsString(..))

import qualified Data.Map as M
import qualified Data.Set as S


instance IsString (TTerm a) where fromString :: String -> TTerm a
fromString = Term -> TTerm a
forall a. Term -> TTerm a
TTerm (Term -> TTerm a) -> (String -> Term) -> String -> TTerm a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Term
Terms.string

infixr 0 >:
(>:) :: String -> TTerm a -> Field
String
n >: :: forall a. String -> TTerm a -> Field
>: TTerm a
d = Name -> Term -> Field
Field (String -> Name
Name String
n) (TTerm a -> Term
forall a. TTerm a -> Term
unTTerm TTerm a
d)

infixr 0 >>:
(>>:) :: Name -> TTerm a -> Field
Name
fname >>: :: forall a. Name -> TTerm a -> Field
>>: TTerm a
d = Name -> Term -> Field
Field Name
fname (TTerm a -> Term
forall a. TTerm a -> Term
unTTerm TTerm a
d)

(<.>) :: TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
TTerm (b -> c)
f <.> :: forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
<.> TTerm (a -> b)
g = TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
compose TTerm (b -> c)
f TTerm (a -> b)
g

-- Two alternative symbols for typed term application
(@@) :: TTerm (a -> b) -> TTerm a -> TTerm b
TTerm (a -> b)
f @@ :: forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm a
x = TTerm (a -> b) -> TTerm a -> TTerm b
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
apply TTerm (a -> b)
f TTerm a
x
($$) :: TTerm (a -> b) -> TTerm a -> TTerm b
TTerm (a -> b)
f $$ :: forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
$$ TTerm a
x = TTerm (a -> b) -> TTerm a -> TTerm b
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
apply TTerm (a -> b)
f TTerm a
x

infixr 0 @->
(@->) :: a -> b -> (a, b)
a
x @-> :: forall a b. a -> b -> (a, b)
@-> b
y = (a
x, b
y)

infixr 0 -->
(-->) :: TCase a -> TTerm (a -> b) -> Field
TCase a
c --> :: forall a b. TCase a -> TTerm (a -> b) -> Field
--> TTerm (a -> b)
t = TCase a -> TTerm (a -> b) -> Field
forall a b. TCase a -> TTerm (a -> b) -> Field
caseField TCase a
c TTerm (a -> b)
t

apply :: TTerm (a -> b) -> TTerm a -> TTerm b
apply :: forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
apply (TTerm Term
lhs) (TTerm Term
rhs) = Term -> TTerm b
forall a. Term -> TTerm a
TTerm (Term -> TTerm b) -> Term -> TTerm b
forall a b. (a -> b) -> a -> b
$ Term -> Term -> Term
Terms.apply Term
lhs Term
rhs

apply2 :: TTerm (a -> b -> c) -> TTerm a -> TTerm b -> TTerm c
apply2 :: forall a b c. TTerm (a -> b -> c) -> TTerm a -> TTerm b -> TTerm c
apply2 (TTerm Term
f) (TTerm Term
a1) (TTerm Term
a2) = Term -> TTerm c
forall a. Term -> TTerm a
TTerm (Term -> TTerm c) -> Term -> TTerm c
forall a b. (a -> b) -> a -> b
$ Term -> Term -> Term
Terms.apply (Term -> Term -> Term
Terms.apply Term
f Term
a1) Term
a2

caseField :: TCase a -> TTerm (a -> b) -> Field
caseField :: forall a b. TCase a -> TTerm (a -> b) -> Field
caseField (TCase Name
fname) (TTerm Term
f) = Name -> Term -> Field
Field Name
fname Term
f

compose :: TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
compose :: forall b c a. TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)
compose (TTerm Term
f) (TTerm Term
g) = Term -> TTerm (a -> c)
forall a. Term -> TTerm a
TTerm (Term -> TTerm (a -> c)) -> Term -> TTerm (a -> c)
forall a b. (a -> b) -> a -> b
$ Term -> Term -> Term
Terms.compose Term
f Term
g

constant :: TTerm a -> TTerm (b -> a)
constant :: forall a b. TTerm a -> TTerm (b -> a)
constant (TTerm Term
term) = Term -> TTerm (b -> a)
forall a. Term -> TTerm a
TTerm (Term -> TTerm (b -> a)) -> Term -> TTerm (b -> a)
forall a b. (a -> b) -> a -> b
$ Term -> Term
Terms.constant Term
term

definitionInModule :: Module -> String -> TTerm a -> TElement a
definitionInModule :: forall a. Module -> String -> TTerm a -> TElement a
definitionInModule Module
mod String
lname = Name -> TTerm a -> TElement a
forall a. Name -> TTerm a -> TElement a
TElement (Name -> TTerm a -> TElement a) -> Name -> TTerm a -> TElement a
forall a b. (a -> b) -> a -> b
$ QualifiedName -> Name
Tier1.unqualifyName (QualifiedName -> Name) -> QualifiedName -> Name
forall a b. (a -> b) -> a -> b
$ Maybe Namespace -> String -> QualifiedName
QualifiedName (Namespace -> Maybe Namespace
forall a. a -> Maybe a
Just (Namespace -> Maybe Namespace) -> Namespace -> Maybe Namespace
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
mod) String
lname

doc :: String -> TTerm a -> TTerm a
doc :: forall a. String -> TTerm a -> TTerm a
doc String
s (TTerm Term
term) = Term -> TTerm a
forall a. Term -> TTerm a
TTerm (Term -> TTerm a) -> Term -> TTerm a
forall a b. (a -> b) -> a -> b
$ Maybe String -> Term -> Term
setTermDescription (String -> Maybe String
forall a. a -> Maybe a
Just String
s) Term
term

doc70 :: String -> TTerm a -> TTerm a
doc70 :: forall a. String -> TTerm a -> TTerm a
doc70 = String -> TTerm a -> TTerm a
forall a. String -> TTerm a -> TTerm a
doc (String -> TTerm a -> TTerm a)
-> (String -> String) -> String -> TTerm a -> TTerm a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
wrapLine Int
70

doc80 :: String -> TTerm a -> TTerm a
doc80 :: forall a. String -> TTerm a -> TTerm a
doc80 = String -> TTerm a -> TTerm a
forall a. String -> TTerm a -> TTerm a
doc (String -> TTerm a -> TTerm a)
-> (String -> String) -> String -> TTerm a -> TTerm a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
wrapLine Int
80

el :: TElement a -> Element
el :: forall a. TElement a -> Element
el (TElement Name
name (TTerm Term
term)) = Name -> Term -> Element
Element Name
name Term
term

field :: Name -> TTerm a -> Field
field :: forall a. Name -> TTerm a -> Field
field Name
fname (TTerm Term
val) = Name -> Term -> Field
Field Name
fname Term
val

first :: TTerm ((a, b) -> a)
first :: forall a b. TTerm ((a, b) -> a)
first = Term -> TTerm ((a, b) -> a)
forall a. Term -> TTerm a
TTerm (Term -> TTerm ((a, b) -> a)) -> Term -> TTerm ((a, b) -> a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Term
Terms.untuple Int
2 Int
0

fld :: Name -> TTerm a -> TField a
fld :: forall a. Name -> TTerm a -> TField a
fld Name
fname (TTerm Term
val) = Field -> TField a
forall a. Field -> TField a
TField (Field -> TField a) -> Field -> TField a
forall a b. (a -> b) -> a -> b
$ Name -> Term -> Field
Field Name
fname Term
val

fold :: TTerm (b -> a -> b) -> TTerm (b -> [a] -> b)
fold :: forall b a. TTerm (b -> a -> b) -> TTerm (b -> [a] -> b)
fold TTerm (b -> a -> b)
f = TTerm ((b -> a -> b) -> b -> [a] -> b)
forall b a. TTerm ((b -> a -> b) -> b -> [a] -> b)
Lists.foldl TTerm ((b -> a -> b) -> b -> [a] -> b)
-> TTerm (b -> a -> b) -> TTerm (b -> [a] -> b)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm (b -> a -> b)
f

function :: Type -> Type -> TTerm a -> TTerm a
function :: forall a. Type -> Type -> TTerm a -> TTerm a
function Type
dom Type
cod = Type -> TTerm a -> TTerm a
forall a. Type -> TTerm a -> TTerm a
typed (Type -> Type -> Type
Types.function Type
dom Type
cod)

functionN :: [Type] -> TTerm a -> TTerm a
functionN :: forall a. [Type] -> TTerm a -> TTerm a
functionN [Type]
ts = Type -> TTerm a -> TTerm a
forall a. Type -> TTerm a -> TTerm a
typed (Type -> TTerm a -> TTerm a) -> Type -> TTerm a -> TTerm a
forall a b. (a -> b) -> a -> b
$ [Type] -> Type
Types.functionN [Type]
ts

functionNWithClasses :: [Type] -> M.Map Name (S.Set TypeClass) -> TTerm a -> TTerm a
functionNWithClasses :: forall a. [Type] -> Map Name (Set TypeClass) -> TTerm a -> TTerm a
functionNWithClasses [Type]
ts Map Name (Set TypeClass)
classes = Type -> TTerm a -> TTerm a
forall a. Type -> TTerm a -> TTerm a
typed (Type -> TTerm a -> TTerm a) -> Type -> TTerm a -> TTerm a
forall a b. (a -> b) -> a -> b
$ Map Name (Set TypeClass) -> Type -> Type
setTypeClasses Map Name (Set TypeClass)
classes ([Type] -> Type
Types.functionN [Type]
ts)

functionWithClasses :: Type -> Type -> M.Map Name (S.Set TypeClass) -> TTerm a -> TTerm a
functionWithClasses :: forall a.
Type -> Type -> Map Name (Set TypeClass) -> TTerm a -> TTerm a
functionWithClasses Type
dom Type
cod Map Name (Set TypeClass)
classes = Type -> TTerm a -> TTerm a
forall a. Type -> TTerm a -> TTerm a
typed (Type -> TTerm a -> TTerm a) -> Type -> TTerm a -> TTerm a
forall a b. (a -> b) -> a -> b
$ Map Name (Set TypeClass) -> Type -> Type
setTypeClasses Map Name (Set TypeClass)
classes (Type -> Type -> Type
Types.function Type
dom Type
cod)

-- Note: Haskell has trouble type-checking this construction if the convenience functions from Base are used
ifElse :: TTerm Bool -> TTerm a -> TTerm a -> TTerm a
ifElse :: forall a. TTerm Bool -> TTerm a -> TTerm a -> TTerm a
ifElse (TTerm Term
cond) (TTerm Term
ifTrue) (TTerm Term
ifFalse) = Term -> TTerm a
forall a. Term -> TTerm a
TTerm (Term -> TTerm a) -> Term -> TTerm a
forall a b. (a -> b) -> a -> b
$
  Term -> Term -> Term
Terms.apply (Term -> Term -> Term
Terms.apply (Term -> Term -> Term
Terms.apply (Name -> Term
Terms.primitive Name
_logic_ifElse) Term
ifTrue) Term
ifFalse) Term
cond

ifOpt :: TTerm (Maybe a) -> TTerm b -> TTerm (a -> b) -> TTerm b
ifOpt :: forall a b. TTerm (Maybe a) -> TTerm b -> TTerm (a -> b) -> TTerm b
ifOpt TTerm (Maybe a)
m TTerm b
n TTerm (a -> b)
j = TTerm b -> TTerm (a -> b) -> TTerm (Maybe a -> b)
forall b a. TTerm b -> TTerm (a -> b) -> TTerm (Maybe a -> b)
matchOpt TTerm b
n TTerm (a -> b)
j TTerm (Maybe a -> b) -> TTerm (Maybe a) -> TTerm b
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm (Maybe a)
m

identity :: TTerm (a -> a)
identity :: forall a. TTerm (a -> a)
identity = Term -> TTerm (a -> a)
forall a. Term -> TTerm a
TTerm Term
Terms.identity

inject :: Name -> Name -> TTerm a -> TTerm b
inject :: forall a b. Name -> Name -> TTerm a -> TTerm b
inject Name
name Name
fname (TTerm Term
term) = Term -> TTerm b
forall a. Term -> TTerm a
TTerm (Term -> TTerm b) -> Term -> TTerm b
forall a b. (a -> b) -> a -> b
$ Name -> Field -> Term
Terms.inject Name
name (Name -> Term -> Field
Field Name
fname Term
term)

inject2 :: Name -> Name -> TTerm (a -> b)
inject2 :: forall a b. Name -> Name -> TTerm (a -> b)
inject2 Name
name Name
fname = String -> TTerm Any -> TTerm (a -> b)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"x2" (TTerm Any -> TTerm (a -> b)) -> TTerm Any -> TTerm (a -> b)
forall a b. (a -> b) -> a -> b
$ Name -> Name -> TTerm Any -> TTerm Any
forall a b. Name -> Name -> TTerm a -> TTerm b
inject Name
name Name
fname (TTerm Any -> TTerm Any) -> TTerm Any -> TTerm Any
forall a b. (a -> b) -> a -> b
$ String -> TTerm Any
forall a. String -> TTerm a
var String
"x2"

just :: TTerm x -> TTerm (Maybe x)
just :: forall x. TTerm x -> TTerm (Maybe x)
just (TTerm Term
term) = Term -> TTerm (Maybe x)
forall a. Term -> TTerm a
TTerm (Term -> TTerm (Maybe x)) -> Term -> TTerm (Maybe x)
forall a b. (a -> b) -> a -> b
$ Term -> Term
Terms.just Term
term

lambda :: String -> TTerm x -> TTerm (a -> b)
lambda :: forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
v (TTerm Term
body) = Term -> TTerm (a -> b)
forall a. Term -> TTerm a
TTerm (Term -> TTerm (a -> b)) -> Term -> TTerm (a -> b)
forall a b. (a -> b) -> a -> b
$ String -> Term -> Term
Terms.lambda String
v Term
body

--letTerm :: Var a -> TTerm a -> TTerm b -> TTerm b
--letTerm (Var k) (TTerm v) (TTerm env) = TTerm $ Terms.letTerm (Name k) v env

list :: [TTerm a] -> TTerm [a]
list :: forall a. [TTerm a] -> TTerm [a]
list [TTerm a]
els = Term -> TTerm [a]
forall a. Term -> TTerm a
TTerm (Term -> TTerm [a]) -> Term -> TTerm [a]
forall a b. (a -> b) -> a -> b
$ [Term] -> Term
Terms.list (TTerm a -> Term
forall a. TTerm a -> Term
unTTerm (TTerm a -> Term) -> [TTerm a] -> [Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TTerm a]
els)

map :: M.Map (TTerm a) (TTerm b) -> TTerm (M.Map a b)
map :: forall a b. Map (TTerm a) (TTerm b) -> TTerm (Map a b)
map = Term -> TTerm (Map a b)
forall a. Term -> TTerm a
TTerm (Term -> TTerm (Map a b))
-> (Map (TTerm a) (TTerm b) -> Term)
-> Map (TTerm a) (TTerm b)
-> TTerm (Map a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Term Term -> Term
Terms.map (Map Term Term -> Term)
-> (Map (TTerm a) (TTerm b) -> Map Term Term)
-> Map (TTerm a) (TTerm b)
-> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Term, Term)] -> Map Term Term
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Term, Term)] -> Map Term Term)
-> (Map (TTerm a) (TTerm b) -> [(Term, Term)])
-> Map (TTerm a) (TTerm b)
-> Map Term Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TTerm a, TTerm b) -> (Term, Term))
-> [(TTerm a, TTerm b)] -> [(Term, Term)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TTerm a, TTerm b) -> (Term, Term)
forall {a} {a}. (TTerm a, TTerm a) -> (Term, Term)
fromTTerm ([(TTerm a, TTerm b)] -> [(Term, Term)])
-> (Map (TTerm a) (TTerm b) -> [(TTerm a, TTerm b)])
-> Map (TTerm a) (TTerm b)
-> [(Term, Term)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (TTerm a) (TTerm b) -> [(TTerm a, TTerm b)]
forall k a. Map k a -> [(k, a)]
M.toList
  where
    fromTTerm :: (TTerm a, TTerm a) -> (Term, Term)
fromTTerm (TTerm Term
k, TTerm Term
v) = (Term
k, Term
v)

match :: Name -> Maybe (TTerm b) -> [Field] -> TTerm (u -> b)
match :: forall b u. Name -> Maybe (TTerm b) -> [Field] -> TTerm (u -> b)
match Name
name Maybe (TTerm b)
dflt [Field]
fields = Term -> TTerm (u -> b)
forall a. Term -> TTerm a
TTerm (Term -> TTerm (u -> b)) -> Term -> TTerm (u -> b)
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Term -> [Field] -> Term
Terms.match Name
name (TTerm b -> Term
forall a. TTerm a -> Term
unTTerm (TTerm b -> Term) -> Maybe (TTerm b) -> Maybe Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TTerm b)
dflt) [Field]
fields

matchData :: Name -> Maybe (TTerm b) -> [(Name, TTerm (x -> b))] -> TTerm (a -> b)
matchData :: forall b x a.
Name
-> Maybe (TTerm b) -> [(Name, TTerm (x -> b))] -> TTerm (a -> b)
matchData Name
name Maybe (TTerm b)
dflt [(Name, TTerm (x -> b))]
pairs = Term -> TTerm (a -> b)
forall a. Term -> TTerm a
TTerm (Term -> TTerm (a -> b)) -> Term -> TTerm (a -> b)
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Term -> [Field] -> Term
Terms.match Name
name (TTerm b -> Term
forall a. TTerm a -> Term
unTTerm (TTerm b -> Term) -> Maybe (TTerm b) -> Maybe Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TTerm b)
dflt) ((Name, TTerm (x -> b)) -> Field
forall {a}. (Name, TTerm a) -> Field
toField ((Name, TTerm (x -> b)) -> Field)
-> [(Name, TTerm (x -> b))] -> [Field]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Name, TTerm (x -> b))]
pairs)
  where
    toField :: (Name, TTerm a) -> Field
toField (Name
fname, TTerm Term
term) = Name -> Term -> Field
Field Name
fname Term
term

matchOpt :: TTerm b -> TTerm (a -> b) -> TTerm (Maybe a -> b)
matchOpt :: forall b a. TTerm b -> TTerm (a -> b) -> TTerm (Maybe a -> b)
matchOpt (TTerm Term
n) (TTerm Term
j) = Term -> TTerm (Maybe a -> b)
forall a. Term -> TTerm a
TTerm (Term -> TTerm (Maybe a -> b)) -> Term -> TTerm (Maybe a -> b)
forall a b. (a -> b) -> a -> b
$ Term -> Term -> Term
Terms.matchOpt Term
n Term
j

matchToEnum :: Name -> Name -> Maybe (TTerm b) -> [(Name, Name)] -> TTerm (a -> b)
matchToEnum :: forall b a.
Name -> Name -> Maybe (TTerm b) -> [(Name, Name)] -> TTerm (a -> b)
matchToEnum Name
domName Name
codName Maybe (TTerm b)
dflt [(Name, Name)]
pairs = Name
-> Maybe (TTerm b) -> [(Name, TTerm (Any -> b))] -> TTerm (a -> b)
forall b x a.
Name
-> Maybe (TTerm b) -> [(Name, TTerm (x -> b))] -> TTerm (a -> b)
matchData Name
domName Maybe (TTerm b)
dflt ((Name, Name) -> (Name, TTerm (Any -> b))
forall {a} {b} {a}. (a, Name) -> (a, TTerm (b -> a))
toCase ((Name, Name) -> (Name, TTerm (Any -> b)))
-> [(Name, Name)] -> [(Name, TTerm (Any -> b))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Name, Name)]
pairs)
  where
    toCase :: (a, Name) -> (a, TTerm (b -> a))
toCase (a
fromName, Name
toName) = (a
fromName, TTerm a -> TTerm (b -> a)
forall a b. TTerm a -> TTerm (b -> a)
constant (TTerm a -> TTerm (b -> a)) -> TTerm a -> TTerm (b -> a)
forall a b. (a -> b) -> a -> b
$ Name -> Name -> TTerm a
forall a. Name -> Name -> TTerm a
unitVariant Name
codName Name
toName)

matchToUnion :: Name -> Name -> Maybe (TTerm b) -> [(Name, Field)] -> TTerm (a -> b)
matchToUnion :: forall b a.
Name
-> Name -> Maybe (TTerm b) -> [(Name, Field)] -> TTerm (a -> b)
matchToUnion Name
domName Name
codName Maybe (TTerm b)
dflt [(Name, Field)]
pairs = Name
-> Maybe (TTerm b) -> [(Name, TTerm (Any -> b))] -> TTerm (a -> b)
forall b x a.
Name
-> Maybe (TTerm b) -> [(Name, TTerm (x -> b))] -> TTerm (a -> b)
matchData Name
domName Maybe (TTerm b)
dflt ((Name, Field) -> (Name, TTerm (Any -> b))
forall {a} {b} {a}. (a, Field) -> (a, TTerm (b -> a))
toCase ((Name, Field) -> (Name, TTerm (Any -> b)))
-> [(Name, Field)] -> [(Name, TTerm (Any -> b))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Name, Field)]
pairs)
  where
    toCase :: (a, Field) -> (a, TTerm (b -> a))
toCase (a
fromName, Field
fld) = (a
fromName, TTerm a -> TTerm (b -> a)
forall a b. TTerm a -> TTerm (b -> a)
constant (TTerm a -> TTerm (b -> a)) -> TTerm a -> TTerm (b -> a)
forall a b. (a -> b) -> a -> b
$ Term -> TTerm a
forall a. Term -> TTerm a
TTerm (Term -> TTerm a) -> Term -> TTerm a
forall a b. (a -> b) -> a -> b
$ Name -> Field -> Term
Terms.inject Name
codName Field
fld)

-- Note: the phantom types provide no guarantee of type safety in this case
nom :: Name -> TTerm a -> TTerm b
nom :: forall a b. Name -> TTerm a -> TTerm b
nom Name
name (TTerm Term
term) = Term -> TTerm b
forall a. Term -> TTerm a
TTerm (Term -> TTerm b) -> Term -> TTerm b
forall a b. (a -> b) -> a -> b
$ Name -> Term -> Term
Terms.wrap Name
name Term
term

nothing :: TTerm a
nothing :: forall a. TTerm a
nothing = Term -> TTerm a
forall a. Term -> TTerm a
TTerm Term
Terms.nothing

opt :: Maybe (TTerm a) -> TTerm (Maybe a)
opt :: forall a. Maybe (TTerm a) -> TTerm (Maybe a)
opt Maybe (TTerm a)
mc = Term -> TTerm (Maybe a)
forall a. Term -> TTerm a
TTerm (Term -> TTerm (Maybe a)) -> Term -> TTerm (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe Term -> Term
Terms.optional (TTerm a -> Term
forall a. TTerm a -> Term
unTTerm (TTerm a -> Term) -> Maybe (TTerm a) -> Maybe Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TTerm a)
mc)

pair :: (TTerm a) -> (TTerm b) -> TTerm (a, b)
pair :: forall a b. TTerm a -> TTerm b -> TTerm (a, b)
pair (TTerm Term
l) (TTerm Term
r) = Term -> TTerm (a, b)
forall a. Term -> TTerm a
TTerm (Term -> TTerm (a, b)) -> Term -> TTerm (a, b)
forall a b. (a -> b) -> a -> b
$ Term -> Term -> Term
Terms.pair Term
l Term
r

primitive :: Name -> TTerm a
primitive :: forall a. Name -> TTerm a
primitive = Term -> TTerm a
forall a. Term -> TTerm a
TTerm (Term -> TTerm a) -> (Name -> Term) -> Name -> TTerm a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Term
Terms.primitive

project :: Name -> Name -> TTerm (a -> b)
project :: forall a b. Name -> Name -> TTerm (a -> b)
project Name
name Name
fname = Term -> TTerm (a -> b)
forall a. Term -> TTerm a
TTerm (Term -> TTerm (a -> b)) -> Term -> TTerm (a -> b)
forall a b. (a -> b) -> a -> b
$ Name -> Name -> Term
Terms.project Name
name Name
fname

record :: Name -> [Field] -> TTerm a
record :: forall a. Name -> [Field] -> TTerm a
record Name
name [Field]
fields = Term -> TTerm a
forall a. Term -> TTerm a
TTerm (Term -> TTerm a) -> Term -> TTerm a
forall a b. (a -> b) -> a -> b
$ Name -> [Field] -> Term
Terms.record Name
name [Field]
fields

ref :: TElement a -> TTerm a
ref :: forall a. TElement a -> TTerm a
ref (TElement Name
name TTerm a
_) = Term -> TTerm a
forall a. Term -> TTerm a
TTerm (Name -> Term
TermVariable Name
name)

second :: TTerm ((a, b) -> b)
second :: forall a b. TTerm ((a, b) -> b)
second = Term -> TTerm ((a, b) -> b)
forall a. Term -> TTerm a
TTerm (Term -> TTerm ((a, b) -> b)) -> Term -> TTerm ((a, b) -> b)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Term
Terms.untuple Int
2 Int
1

set :: S.Set (TTerm a) -> TTerm (S.Set a)
set :: forall a. Set (TTerm a) -> TTerm (Set a)
set = Term -> TTerm (Set a)
forall a. Term -> TTerm a
TTerm (Term -> TTerm (Set a))
-> (Set (TTerm a) -> Term) -> Set (TTerm a) -> TTerm (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Term -> Term
Terms.set (Set Term -> Term)
-> (Set (TTerm a) -> Set Term) -> Set (TTerm a) -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Term] -> Set Term
forall a. Ord a => [a] -> Set a
S.fromList ([Term] -> Set Term)
-> (Set (TTerm a) -> [Term]) -> Set (TTerm a) -> Set Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TTerm a -> Term) -> [TTerm a] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TTerm a -> Term
forall a. TTerm a -> Term
unTTerm ([TTerm a] -> [Term])
-> (Set (TTerm a) -> [TTerm a]) -> Set (TTerm a) -> [Term]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (TTerm a) -> [TTerm a]
forall a. Set a -> [a]
S.toList

typed :: Type -> TTerm a -> TTerm a
typed :: forall a. Type -> TTerm a -> TTerm a
typed Type
typ (TTerm Term
term) = Term -> TTerm a
forall a. Term -> TTerm a
TTerm (Term -> TTerm a) -> Term -> TTerm a
forall a b. (a -> b) -> a -> b
$ Maybe Type -> Term -> Term
setTermType (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
typ) Term
term

unit :: TTerm a
unit :: forall a. TTerm a
unit = Term -> TTerm a
forall a. Term -> TTerm a
TTerm Term
Terms.unit

unitVariant :: Name -> Name -> TTerm a
unitVariant :: forall a. Name -> Name -> TTerm a
unitVariant Name
name Name
fname = Term -> TTerm a
forall a. Term -> TTerm a
TTerm (Term -> TTerm a) -> Term -> TTerm a
forall a b. (a -> b) -> a -> b
$ Name -> Field -> Term
Terms.inject Name
name (Field -> Term) -> Field -> Term
forall a b. (a -> b) -> a -> b
$ Name -> Term -> Field
Field Name
fname Term
Terms.unit

unwrap :: Name -> TTerm (a -> b)
unwrap :: forall a b. Name -> TTerm (a -> b)
unwrap = Term -> TTerm (a -> b)
forall a. Term -> TTerm a
TTerm (Term -> TTerm (a -> b))
-> (Name -> Term) -> Name -> TTerm (a -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Term
Terms.unwrap

var :: String -> TTerm a
var :: forall a. String -> TTerm a
var String
v = Term -> TTerm a
forall a. Term -> TTerm a
TTerm (Term -> TTerm a) -> Term -> TTerm a
forall a b. (a -> b) -> a -> b
$ String -> Term
Terms.var String
v

variant :: Name -> Name -> TTerm a -> TTerm b
variant :: forall a b. Name -> Name -> TTerm a -> TTerm b
variant Name
name Name
fname (TTerm Term
term) = Term -> TTerm b
forall a. Term -> TTerm a
TTerm (Term -> TTerm b) -> Term -> TTerm b
forall a b. (a -> b) -> a -> b
$ Name -> Field -> Term
Terms.inject Name
name (Field -> Term) -> Field -> Term
forall a b. (a -> b) -> a -> b
$ Name -> Term -> Field
Field Name
fname Term
term

with :: TTerm a -> [Field] -> TTerm a
(TTerm Term
env) with :: forall a. TTerm a -> [Field] -> TTerm a
`with` [Field]
fields = Term -> TTerm a
forall a. Term -> TTerm a
TTerm (Term -> TTerm a) -> Term -> TTerm a
forall a b. (a -> b) -> a -> b
$ Let -> Term
TermLet (Let -> Term) -> Let -> Term
forall a b. (a -> b) -> a -> b
$ [LetBinding] -> Term -> Let
Let (Field -> LetBinding
toBinding (Field -> LetBinding) -> [Field] -> [LetBinding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field]
fields) Term
env
  where
     toBinding :: Field -> LetBinding
toBinding (Field Name
name Term
value) = Name -> Term -> Maybe TypeScheme -> LetBinding
LetBinding Name
name Term
value Maybe TypeScheme
forall a. Maybe a
Nothing

wrap :: Name -> TTerm a -> TTerm b
wrap :: forall a b. Name -> TTerm a -> TTerm b
wrap Name
name (TTerm Term
term) = Term -> TTerm b
forall a. Term -> TTerm a
TTerm (Term -> TTerm b) -> Term -> TTerm b
forall a b. (a -> b) -> a -> b
$ Name -> Term -> Term
Terms.wrap Name
name Term
term