{-# LANGUAGE OverloadedStrings #-}

module Wave.Builtins where

import qualified Data.Map as M
import qualified Data.Text as T
import Wave.Ast
import Wave.Common
import Wave.Types

type Builtins = M.Map Var Builtin

data Builtin = Builtin
  { Builtin -> Var
bName :: Var,
    Builtin -> Type
bType :: Type,
    Builtin -> Impl
bImpl :: Impl
  }

data Impl
  = Fun T.Text
  | BinOp T.Text

builtinFun :: Var -> Type -> T.Text -> (Var, Builtin)
builtinFun :: Var -> Type -> Var -> (Var, Builtin)
builtinFun = (Var -> Impl) -> Var -> Type -> Var -> (Var, Builtin)
builtin Var -> Impl
Fun

builtinBinOp :: Var -> Type -> T.Text -> (Var, Builtin)
builtinBinOp :: Var -> Type -> Var -> (Var, Builtin)
builtinBinOp = (Var -> Impl) -> Var -> Type -> Var -> (Var, Builtin)
builtin Var -> Impl
BinOp

builtin :: (T.Text -> Impl) -> Var -> Type -> T.Text -> (Var, Builtin)
builtin :: (Var -> Impl) -> Var -> Type -> Var -> (Var, Builtin)
builtin Var -> Impl
c Var
n Type
t Var
i = (Var
n, Var -> Type -> Impl -> Builtin
Builtin Var
n Type
t (Impl -> Builtin) -> Impl -> Builtin
forall a b. (a -> b) -> a -> b
$ Var -> Impl
c Var
i)

builtins :: Builtins
builtins :: Builtins
builtins =
  [Builtins] -> Builtins
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions
    [ Builtins
ints,
      Builtins
strings,
      Builtins
bools
    ]

ints :: Builtins
ints :: Builtins
ints =
  [(Var, Builtin)] -> Builtins
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ Var -> Type -> Var -> (Var, Builtin)
builtinBinOp Var
"add" Type
binOpInt Var
"+",
      Var -> Type -> Var -> (Var, Builtin)
builtinBinOp Var
"sub" Type
binOpInt Var
"-",
      Var -> Type -> Var -> (Var, Builtin)
builtinBinOp Var
"mul" Type
binOpInt Var
"*",
      Var -> Type -> Var -> (Var, Builtin)
builtinBinOp Var
"div" Type
binOpInt Var
"/",
      Var -> Type -> Var -> (Var, Builtin)
builtinFun Var
"negate" Type
opInt Var
"function (x) { return 0 - x }"
    ]
  where
    binOpInt :: Type
binOpInt = [Type] -> Type -> Type
TypeFun [Type
tInt, Type
tInt] Type
tInt
    opInt :: Type
opInt = [Type] -> Type -> Type
TypeFun [Type
tInt] Type
tInt

strings :: Builtins
strings :: Builtins
strings =
  [(Var, Builtin)] -> Builtins
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [Var -> Type -> Var -> (Var, Builtin)
builtinBinOp Var
"concat" Type
binOpInt Var
"+"]
  where
    binOpInt :: Type
binOpInt = [Type] -> Type -> Type
TypeFun [Type
tString, Type
tString] Type
tString

bools :: Builtins
bools :: Builtins
bools =
  [(Var, Builtin)] -> Builtins
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ Var -> Type -> Var -> (Var, Builtin)
builtinBinOp Var
"and" Type
binOpInt Var
"&&",
      Var -> Type -> Var -> (Var, Builtin)
builtinBinOp Var
"or" Type
binOpInt Var
"||",
      Var -> Type -> Var -> (Var, Builtin)
builtinFun Var
"not" Type
opInt Var
"function (x) { return !x }"
    ]
  where
    binOpInt :: Type
binOpInt = [Type] -> Type -> Type
TypeFun [Type
tBool, Type
tBool] Type
tBool
    opInt :: Type
opInt = [Type] -> Type -> Type
TypeFun [Type
tBool] Type
tBool

-- Builtin values
unit :: Expr ()
unit :: Expr ()
unit = Record (Expr ()) -> Expr ()
forall a. Record (Expr a) -> Expr a
ERecord Record (Expr ())
forall k a. Map k a
M.empty

true :: Expr ()
true :: Expr ()
true = Variant (Expr ()) -> Expr ()
forall a. Variant (Expr a) -> Expr a
EVariant (Variant (Expr ()) -> Expr ()) -> Variant (Expr ()) -> Expr ()
forall a b. (a -> b) -> a -> b
$ Var -> Expr () -> Variant (Expr ())
forall a. Var -> a -> Variant a
Variant Var
"True" Expr ()
unit

false :: Expr ()
false :: Expr ()
false = Variant (Expr ()) -> Expr ()
forall a. Variant (Expr a) -> Expr a
EVariant (Variant (Expr ()) -> Expr ()) -> Variant (Expr ()) -> Expr ()
forall a b. (a -> b) -> a -> b
$ Var -> Expr () -> Variant (Expr ())
forall a. Var -> a -> Variant a
Variant Var
"False" Expr ()
unit

-- Builtin types
tUnit :: Type
tUnit :: Type
tUnit = [(Var, Type)] -> Type
TypeRec []

tInt :: Type
tInt :: Type
tInt = Var -> Type
TypeCon Var
"Int"

tFloat :: Type
tFloat :: Type
tFloat = Var -> Type
TypeCon Var
"Float"

tString :: Type
tString :: Type
tString = Var -> Type
TypeCon Var
"String"

tBool :: Type
tBool :: Type
tBool = Var -> Type
TypeCon Var
"Bool"

-- Builtin datatypes
bool :: DataType
bool :: DataType
bool =
  Var -> [Var] -> [Variant Type] -> DataType
DataType
    Var
"Bool"
    []
    [ Var -> Type -> Variant Type
forall a. Var -> a -> Variant a
Variant Var
"True" Type
tUnit,
      Var -> Type -> Variant Type
forall a. Var -> a -> Variant a
Variant Var
"False" Type
tUnit
    ]

maybe :: DataType
maybe :: DataType
maybe =
  Var -> [Var] -> [Variant Type] -> DataType
DataType
    Var
"Maybe"
    [Var
"a"]
    [ Var -> Type -> Variant Type
forall a. Var -> a -> Variant a
Variant Var
"Just" (Type -> Variant Type) -> Type -> Variant Type
forall a b. (a -> b) -> a -> b
$ Var -> Type
TypeVar Var
"a",
      Var -> Type -> Variant Type
forall a. Var -> a -> Variant a
Variant Var
"None" Type
tUnit
    ]