{- | Builtin stuff

Includes:

- builtin types
- values
- datatypes
- function implementations

-}

{-# language OverloadedStrings #-}

module Language.Giml.Builtins
  ( -- * Types
    tUnit
  , tInt
  , tFloat
  , tString
  , tBool
  , tIO
  , tIORef
    -- * Values
  , true
  , false
  , unit
    -- * Data types
  , builtinDatatypes
  , dataBool
  , dataOption
    -- * Functions
  , Builtins
  , Builtin(..)
  , Impl(..)
  , builtins
  )
  where

import qualified Data.Text as T
import qualified Data.Map as M

import Language.Giml.Syntax.Ast

-- * Types

tUnit :: Type
tUnit :: Type
tUnit = [(Label, Type)] -> Type
TypeRec [(Label, Type)]
forall a. Monoid a => a
mempty

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

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

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

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

-- | A type representing IO actions
tIO :: Type -> Type
tIO :: Type -> Type
tIO = Type -> Type -> Type
TypeApp (Label -> Type
TypeCon Label
"IO")

-- | A type representing IO actions
tIORef :: Type -> Type
tIORef :: Type -> Type
tIORef = Type -> Type -> Type
TypeApp (Label -> Type
TypeCon Label
"IORef")


-- * Values

true :: Expr ()
true :: Expr ()
true = Label -> Expr ()
forall a. Label -> Expr a
EVariant Label
"True"

false :: Expr ()
false :: Expr ()
false = Label -> Expr ()
forall a. Label -> Expr a
EVariant Label
"False"

unit :: Expr ()
unit :: Expr ()
unit = Record (Expr ()) -> Expr ()
forall a. Record (Expr a) -> Expr a
ERecord Record (Expr ())
forall a. Monoid a => a
mempty

-- * Data types

builtinDatatypes :: [Datatype ()]
builtinDatatypes :: [Datatype ()]
builtinDatatypes =
  [ Datatype ()
dataBool
  , Datatype ()
dataOption
  ]

dataBool :: Datatype ()
dataBool :: Datatype ()
dataBool =
  () -> Label -> [Label] -> [Variant (Maybe Type)] -> Datatype ()
forall a.
a -> Label -> [Label] -> [Variant (Maybe Type)] -> Datatype a
Datatype () Label
"Bool" []
    [ Label -> Maybe Type -> Variant (Maybe Type)
forall a. Label -> a -> Variant a
Variant Label
"True" Maybe Type
forall a. Maybe a
Nothing
    , Label -> Maybe Type -> Variant (Maybe Type)
forall a. Label -> a -> Variant a
Variant Label
"False" Maybe Type
forall a. Maybe a
Nothing
    ]

dataOption :: Datatype ()
dataOption :: Datatype ()
dataOption =
  () -> Label -> [Label] -> [Variant (Maybe Type)] -> Datatype ()
forall a.
a -> Label -> [Label] -> [Variant (Maybe Type)] -> Datatype a
Datatype () Label
"Option" [Label
"a"]
    [ Label -> Maybe Type -> Variant (Maybe Type)
forall a. Label -> a -> Variant a
Variant Label
"Some" (Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ Label -> Type
TypeVar Label
"a")
    , Label -> Maybe Type -> Variant (Maybe Type)
forall a. Label -> a -> Variant a
Variant Label
"None" Maybe Type
forall a. Maybe a
Nothing
    ]

-- * Functions

-- | A Built-in function
data Builtin
  = Builtin
    { Builtin -> Label
bName :: Var -- ^ the name
    , Builtin -> Type
bType :: Type -- ^ the type
    , Builtin -> Impl
bImpl :: Impl -- ^ the implementation
    }

-- | The type of the function and it's
--   implementation in the target source code
data Impl
  = Func T.Text
  | BinOp T.Text

type Builtins = M.Map Var Builtin

-- | All of the builtin functions
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
bools
  , Builtins
strings
  , Builtins
io
  ]

-- | Integer builtins
ints :: Builtins
ints :: Builtins
ints = [(Label, Builtin)] -> Builtins
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ Label -> Type -> Label -> (Label, Builtin)
binop Label
"add" Type
binInt Label
"+"
  , Label -> Type -> Label -> (Label, Builtin)
binop Label
"sub" Type
binInt Label
"-"
  , Label -> Type -> Label -> (Label, Builtin)
binop Label
"mul" Type
binInt Label
"*"
  , Label -> Type -> Label -> (Label, Builtin)
binop Label
"div" Type
binInt Label
"/"
  , Label -> Type -> Label -> (Label, Builtin)
func Label
"negate" ([Type] -> Type -> Type
typeFun [Type
tInt] Type
tInt)
    Label
"function (x) { return 0 - x; }"

  , Label -> Type -> Label -> (Label, Builtin)
binop Label
"int_equals" ([Type] -> Type -> Type
typeFun [Type
tInt, Type
tInt] Type
tBool)
    Label
"==="
  , Label -> Type -> Label -> (Label, Builtin)
binop Label
"int_lesser" ([Type] -> Type -> Type
typeFun [Type
tInt, Type
tInt] Type
tBool)
    Label
"<"
  , Label -> Type -> Label -> (Label, Builtin)
binop Label
"int_lesser_eq" ([Type] -> Type -> Type
typeFun [Type
tInt, Type
tInt] Type
tBool)
    Label
"<="
  , Label -> Type -> Label -> (Label, Builtin)
binop Label
"int_greater" ([Type] -> Type -> Type
typeFun [Type
tInt, Type
tInt] Type
tBool)
    Label
">"
  , Label -> Type -> Label -> (Label, Builtin)
binop Label
"int_greater_eq" ([Type] -> Type -> Type
typeFun [Type
tInt, Type
tInt] Type
tBool)
    Label
">="
  ]
  where
    binInt :: Type
binInt = [Type] -> Type -> Type
typeFun [Type
tInt, Type
tInt] Type
tInt

-- | Boolean builtins
bools :: Builtins
bools :: Builtins
bools = [(Label, Builtin)] -> Builtins
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ Label -> Type -> Label -> (Label, Builtin)
binop Label
"and" ([Type] -> Type -> Type
typeFun [Type
tBool, Type
tBool] Type
tBool)
    Label
"&&"
  , Label -> Type -> Label -> (Label, Builtin)
binop Label
"or" ([Type] -> Type -> Type
typeFun [Type
tBool, Type
tBool] Type
tBool)
    Label
"||"
  , Label -> Type -> Label -> (Label, Builtin)
func Label
"not" ([Type] -> Type -> Type
typeFun [Type
tBool] Type
tBool)
    Label
"function (x) { return !x; }"
  ]

-- | String builtins
strings :: Builtins
strings :: Builtins
strings = [(Label, Builtin)] -> Builtins
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ Label -> Type -> Label -> (Label, Builtin)
binop Label
"concat" ([Type] -> Type -> Type
typeFun [Type
tString, Type
tString] Type
tString)
    Label
"+"
  ]


-- | Builtin IO operations
--   We represent IO actions as functions without arguments
io :: Builtins
io :: Builtins
io = [(Label, Builtin)] -> Builtins
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ Label -> Type -> Label -> (Label, Builtin)
func Label
"pure" ([Type] -> Type -> Type
typeFun [Label -> Type
TypeVar Label
"a"] (Type -> Type
tIO (Label -> Type
TypeVar Label
"a")))
    Label
"function(x) { return function() { return x; }; }"
  ] Builtins -> Builtins -> Builtins
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Builtins
ioRef


-- | Builtin IORef operations
--
--   IORefs are mutable variables that can be manipulated from IO code.
--
--   They are represented as objects with a @value@ field which holds the value.
ioRef :: Builtins
ioRef :: Builtins
ioRef = [(Label, Builtin)] -> Builtins
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ Label -> Type -> Label -> (Label, Builtin)
func Label
"newIORef" ([Type] -> Type -> Type
typeFun [Label -> Type
TypeVar Label
"a"] (Type -> Type
tIO (Type -> Type
tIORef (Label -> Type
TypeVar Label
"a"))))
    Label
"function(x) { return function() { return { value : x }; }; }"
  , Label -> Type -> Label -> (Label, Builtin)
func Label
"readIORef" ([Type] -> Type -> Type
typeFun [Type -> Type
tIORef (Label -> Type
TypeVar Label
"a")] (Type -> Type
tIO (Label -> Type
TypeVar Label
"a")))
    Label
"function(x) { return function() { return x.value; }; }"
  , Label -> Type -> Label -> (Label, Builtin)
func Label
"writeIORef" ([Type] -> Type -> Type
typeFun [Type -> Type
tIORef (Label -> Type
TypeVar Label
"a"), Label -> Type
TypeVar Label
"a"] (Type -> Type
tIO Type
tUnit))
    Label
"function(x) { return function(v) { return function() { x.value = v; return {}; }; }; }"
  , Label -> Type -> Label -> (Label, Builtin)
func Label
"modifyIORef"
    ( [Type] -> Type -> Type
typeFun
      [ Type -> Type
tIORef (Label -> Type
TypeVar Label
"a")
      , [Type] -> Type -> Type
typeFun [Label -> Type
TypeVar Label
"a"] (Label -> Type
TypeVar Label
"a")
      ]
      (Type -> Type
tIO Type
tUnit)
    )
    Label
"function(x) { return function(f) { return function() { x.value = f(x.value); return {}; }; }; }"
  ]

-- | Binary operator helper constructor
binop :: Var -> Type -> T.Text -> (Var, Builtin)
binop :: Label -> Type -> Label -> (Label, Builtin)
binop Label
name Type
typ Label
impl =
  (Label
name, Label -> Type -> Impl -> Builtin
Builtin Label
name Type
typ (Label -> Impl
BinOp Label
impl))

-- | Function helper constructor
func :: Var -> Type -> T.Text -> (Var, Builtin)
func :: Label -> Type -> Label -> (Label, Builtin)
func Label
name Type
typ Label
impl =
  (Label
name, Label -> Type -> Impl -> Builtin
Builtin Label
name Type
typ (Label -> Impl
Func Label
impl))