-- | A bootstrapping DSL, used for Hydra's inner core models

module Hydra.Dsl.Bootstrap where

import Hydra.Compute
import Hydra.Constants
import Hydra.Core
import Hydra.CoreEncoding
import Hydra.Graph
import Hydra.Annotations
import Hydra.Module
import Hydra.Rewriting
import Hydra.Sources.Libraries
import qualified Hydra.Dsl.Terms as Terms
import qualified Hydra.Dsl.Types as Types
import Hydra.Tools.Debug

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


-- | An empty graph (no elements, no primitives, but an annotation class) which is used for bootstrapping Hydra Core
bootstrapGraph :: Graph
bootstrapGraph :: Graph
bootstrapGraph = Graph {
  graphElements :: Map Name Element
graphElements = Map Name Element
forall k a. Map k a
M.empty,
  graphEnvironment :: Map Name (Maybe Term)
graphEnvironment = Map Name (Maybe Term)
forall k a. Map k a
M.empty,
  graphTypes :: Map Name Type
graphTypes = Map Name Type
forall k a. Map k a
M.empty,
  graphBody :: Term
graphBody = [Term] -> Term
Terms.list [], -- Note: the bootstrap body is arbitrary
  graphPrimitives :: Map Name Primitive
graphPrimitives = [(Name, Primitive)] -> Map Name Primitive
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Primitive)] -> Map Name Primitive)
-> [(Name, Primitive)] -> Map Name Primitive
forall a b. (a -> b) -> a -> b
$ (Primitive -> (Name, Primitive))
-> [Primitive] -> [(Name, Primitive)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Primitive
p -> (Primitive -> Name
primitiveName Primitive
p, Primitive
p)) [Primitive]
standardPrimitives,
  graphSchema :: Maybe Graph
graphSchema = Maybe Graph
forall a. Maybe a
Nothing}

datatype :: Namespace -> String -> Type -> Element
datatype :: Namespace -> String -> Type -> Element
datatype Namespace
gname String
lname Type
typ = Name -> Type -> Element
typeElement Name
elName (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ ((Type -> Type) -> Type -> Type)
-> (Map String Term -> Map String Term) -> Type -> Type
rewriteType (Type -> Type) -> Type -> Type
forall {p}. (p -> Type) -> p -> Type
replacePlaceholders Map String Term -> Map String Term
forall a. a -> a
id Type
typ
  where
    elName :: Name
elName = Namespace -> Name -> Name
qualify Namespace
gname (String -> Name
Name String
lname)

    -- Note: placeholders are only expected at the top level, or beneath annotations and/or type lambdas
    replacePlaceholders :: (p -> Type) -> p -> Type
replacePlaceholders p -> Type
rec p
t = case Type
rect of
        TypeRecord (RowType Name
tname Maybe Name
e [FieldType]
fields) -> if Name
tname Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
placeholderName
          then RowType -> Type
TypeRecord (Name -> Maybe Name -> [FieldType] -> RowType
RowType Name
elName Maybe Name
e [FieldType]
fields)
          else Type
rect
        TypeUnion (RowType Name
tname Maybe Name
e [FieldType]
fields) -> if Name
tname Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
placeholderName
          then RowType -> Type
TypeUnion (Name -> Maybe Name -> [FieldType] -> RowType
RowType Name
elName Maybe Name
e [FieldType]
fields)
          else Type
rect
        TypeWrap (WrappedType Name
tname Type
t) -> if Name
tname Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
placeholderName
          then WrappedType -> Type
TypeWrap (Name -> Type -> WrappedType
WrappedType Name
elName Type
t)
          else Type
rect
        Type
_ -> Type
rect
      where
        rect :: Type
rect = p -> Type
rec p
t

typeref :: Namespace -> String -> Type
typeref :: Namespace -> String -> Type
typeref Namespace
ns = Name -> Type
TypeVariable (Name -> Type) -> (String -> Name) -> String -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Namespace -> Name -> Name
qualify Namespace
ns (Name -> Name) -> (String -> Name) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
Name

qualify :: Namespace -> Name -> Name
qualify :: Namespace -> Name -> Name
qualify (Namespace String
gname) (Name String
lname) = String -> Name
Name (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
gname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lname

typeElement :: Name -> Type -> Element
typeElement :: Name -> Type -> Element
typeElement Name
name Type
typ = Element {
    elementName :: Name
elementName = Name
name,
    elementData :: Term
elementData = Term
dataTerm}
  where
    -- These type annotations allow type inference to proceed despite cyclic type definitions, e.g. in Hydra Core
    dataTerm :: Term
dataTerm = Term -> Term
normalizeTermAnnotations (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$ AnnotatedTerm -> Term
TermAnnotated (AnnotatedTerm -> Term) -> AnnotatedTerm -> Term
forall a b. (a -> b) -> a -> b
$ Term -> Map String Term -> AnnotatedTerm
AnnotatedTerm (Type -> Term
coreEncodeType Type
typ) (Map String Term -> AnnotatedTerm)
-> Map String Term -> AnnotatedTerm
forall a b. (a -> b) -> a -> b
$ [(String, Term)] -> Map String Term
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String
key_type, Term
schemaTerm)]
    schemaTerm :: Term
schemaTerm = Name -> Term
TermVariable Name
_Type