module Inferno.Module.Builtin (builtinModule, emptyHash, oneHash, enumBoolHash) where

import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Text (Text)
import Inferno.Types.Module (BuiltinEnumHash (..), BuiltinFunHash (..), BuiltinModuleHash (..), Module (..), PinnedModule)
import Inferno.Types.Syntax (Expr (..), ExtIdent (..), ImplExpl (..), Scoped (..))
import Inferno.Types.Type
  ( ImplType (..),
    InfernoType (..),
    Namespace (..),
    TCScheme (..),
    TV (..),
    TypeClass (TypeClass),
    TypeMetadata (..),
    typeBool,
    typeDouble,
    typeInt,
    (.->),
  )
import Inferno.Types.VersionControl (VCObjectHash, vcHash)

-- The builtin module is a dummy module only used for typechecking purposes
-- it contains the bool enum, which must exist because the `if...then..else..` that's built into the
-- basic AST type expects a boolean value in its first argument.
-- The module also includes some meta information for the `Some/None` constructors of the `option` type,
-- which is again built into the language.
-- NOTE: the code and the hashes use the old `one/empty` terms for legacy reasons
builtinModule :: PinnedModule ()
builtinModule :: PinnedModule ()
builtinModule =
  Module
    { moduleName :: ModuleName
moduleName = ModuleName
"Builtin",
      moduleOpsTable :: OpsTable
moduleOpsTable = forall a. Monoid a => a
mempty,
      moduleObjects :: (Map Namespace VCObjectHash,
 Map VCObjectHash (TypeMetadata TCScheme), ())
moduleObjects = (Map Namespace VCObjectHash
name2Hash, Map VCObjectHash (TypeMetadata TCScheme)
hash2ty, ()),
      moduleTypeClasses :: Set TypeClass
moduleTypeClasses =
        forall a. Ord a => [a] -> Set a
Set.fromList
          [ Text -> [InfernoType] -> TypeClass
TypeClass Text
"numeric" [InfernoType
typeInt],
            Text -> [InfernoType] -> TypeClass
TypeClass Text
"numeric" [InfernoType
typeDouble]
          ]
    }
  where
    name2Hash :: Map Namespace VCObjectHash
name2Hash =
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (ModuleName -> Namespace
ModuleNamespace ModuleName
"Builtin", forall obj. VCHashUpdate obj => obj -> VCObjectHash
vcHash forall a b. (a -> b) -> a -> b
$ ModuleName -> BuiltinModuleHash
BuiltinModuleHash ModuleName
"Builtin"),
          (Ident -> Namespace
TypeNamespace Ident
"bool", VCObjectHash
enumBoolHash),
          (Ident -> Namespace
EnumNamespace Ident
"true", VCObjectHash
enumBoolHash),
          (Ident -> Namespace
EnumNamespace Ident
"false", VCObjectHash
enumBoolHash),
          (Ident -> Namespace
FunNamespace Ident
"None", VCObjectHash
emptyHash),
          (Ident -> Namespace
FunNamespace Ident
"Some", VCObjectHash
oneHash)
        ]
    hash2ty :: Map VCObjectHash (TypeMetadata TCScheme)
hash2ty =
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ ( VCObjectHash
enumBoolHash,
            TypeMetadata
              { identExpr :: Expr () ()
identExpr = forall hash pos.
pos -> hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
Var () () forall a. Scoped a
LocalScope (ExtIdent -> ImplExpl
Expl forall a b. (a -> b) -> a -> b
$ Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Text
"_"),
                ty :: TCScheme
ty = [TV] -> Set TypeClass -> ImplType -> TCScheme
ForallTC [] forall a. Set a
Set.empty forall a b. (a -> b) -> a -> b
$ Map ExtIdent InfernoType -> InfernoType -> ImplType
ImplType forall k a. Map k a
Map.empty forall a b. (a -> b) -> a -> b
$ InfernoType
typeBool,
                docs :: Maybe Text
docs = forall a. a -> Maybe a
Just Text
"Boolean type"
              }
          ),
          ( VCObjectHash
emptyHash,
            TypeMetadata
              { identExpr :: Expr () ()
identExpr = forall hash pos. pos -> Expr hash pos
Empty (),
                ty :: TCScheme
ty = TCScheme
emptyTy,
                docs :: Maybe Text
docs = Maybe Text
optionMetaText
              }
          ),
          ( VCObjectHash
oneHash,
            TypeMetadata
              { identExpr :: Expr () ()
identExpr = forall hash pos.
pos -> hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
Var () () forall a. Scoped a
LocalScope forall a b. (a -> b) -> a -> b
$ ExtIdent -> ImplExpl
Expl forall a b. (a -> b) -> a -> b
$ Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Text
"Some",
                ty :: TCScheme
ty = TCScheme
oneTy,
                docs :: Maybe Text
docs = Maybe Text
optionMetaText
              }
          )
        ]

    optionMetaText :: Maybe Text
    optionMetaText :: Maybe Text
optionMetaText =
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        Text
"Optional type, representing a value which may be undefined.\n"
          forall a. Semigroup a => a -> a -> a
<> Text
"`None` indicates no value is present and `Some v` holds a value `v`\n   "
          forall a. Semigroup a => a -> a -> a
<> Text
"To test whether an optional `o` holds some value, use `match ... with` and pattern match on `o`:\n"
          forall a. Semigroup a => a -> a -> a
<> Text
"~~~\nmatch o with {\n  | Some v -> // use v here\n  | None -> // handle the case where o is None\n}\n~~~"

emptyTy, oneTy, boolTy :: TCScheme
emptyTy :: TCScheme
emptyTy = [TV] -> Set TypeClass -> ImplType -> TCScheme
ForallTC [Int -> TV
TV Int
0] forall a. Set a
Set.empty forall a b. (a -> b) -> a -> b
$ Map ExtIdent InfernoType -> InfernoType -> ImplType
ImplType forall k a. Map k a
Map.empty forall a b. (a -> b) -> a -> b
$ InfernoType -> InfernoType
TOptional (TV -> InfernoType
TVar forall a b. (a -> b) -> a -> b
$ Int -> TV
TV Int
0)
oneTy :: TCScheme
oneTy = [TV] -> Set TypeClass -> ImplType -> TCScheme
ForallTC [Int -> TV
TV Int
0] forall a. Set a
Set.empty forall a b. (a -> b) -> a -> b
$ Map ExtIdent InfernoType -> InfernoType -> ImplType
ImplType forall k a. Map k a
Map.empty forall a b. (a -> b) -> a -> b
$ TV -> InfernoType
TVar (Int -> TV
TV Int
0) InfernoType -> InfernoType -> InfernoType
.-> InfernoType -> InfernoType
TOptional (TV -> InfernoType
TVar forall a b. (a -> b) -> a -> b
$ Int -> TV
TV Int
0)
boolTy :: TCScheme
boolTy = [TV] -> Set TypeClass -> ImplType -> TCScheme
ForallTC [] forall a. Set a
Set.empty forall a b. (a -> b) -> a -> b
$ Map ExtIdent InfernoType -> InfernoType -> ImplType
ImplType forall k a. Map k a
Map.empty forall a b. (a -> b) -> a -> b
$ InfernoType
typeBool

emptyHash, oneHash, enumBoolHash :: VCObjectHash
emptyHash :: VCObjectHash
emptyHash = Text -> TCScheme -> VCObjectHash
builtinFunHash Text
"empty" TCScheme
emptyTy
oneHash :: VCObjectHash
oneHash = Text -> TCScheme -> VCObjectHash
builtinFunHash Text
"one" TCScheme
oneTy
enumBoolHash :: VCObjectHash
enumBoolHash = forall obj. VCHashUpdate obj => obj -> VCObjectHash
vcHash forall a b. (a -> b) -> a -> b
$ TCScheme -> BuiltinEnumHash
BuiltinEnumHash forall a b. (a -> b) -> a -> b
$ TCScheme
boolTy

builtinFunHash :: Text -> TCScheme -> VCObjectHash
builtinFunHash :: Text -> TCScheme -> VCObjectHash
builtinFunHash Text
n TCScheme
ty = forall obj. VCHashUpdate obj => obj -> VCObjectHash
vcHash forall a b. (a -> b) -> a -> b
$ (Expr () (), TCScheme) -> BuiltinFunHash
BuiltinFunHash (forall hash pos.
pos -> hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
Var () () forall a. Scoped a
LocalScope forall a b. (a -> b) -> a -> b
$ ExtIdent -> ImplExpl
Expl forall a b. (a -> b) -> a -> b
$ Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Text
n, TCScheme
ty)