{-# LANGUAGE OverloadedStrings #-}

module StdLib
  ( TypedDeclaration,
    typedDecls,
    decls,
    DeclarationWithArity,
    allDeclsWithArity,
  )
where

import Data.Functor.Base (ListF (..))
import Data.Functor.Foldable (hylo)
import Trees.Common (Arity, Identifier, Type (..))

-- * Standard Library

type TypedDeclaration = (Identifier, Type)

-- | The list of typed standard declarations.
typedDecls :: [TypedDeclaration]
typedDecls :: [TypedDeclaration]
typedDecls = [TypedDeclaration
notDecl, TypedDeclaration
printBoolDecl, TypedDeclaration
printIntDecl]

-- | The list of standard declarations.
decls :: [Identifier]
decls :: [Identifier]
decls = TypedDeclaration -> Identifier
forall a b. (a, b) -> a
fst (TypedDeclaration -> Identifier)
-> [TypedDeclaration] -> [Identifier]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypedDeclaration]
typedDecls

type DeclarationWithArity = (Identifier, Arity)

-- | The list of all (including internal) standard declarations with their arity.
allDeclsWithArity :: [DeclarationWithArity]
allDeclsWithArity :: [DeclarationWithArity]
allDeclsWithArity = (TypedDeclaration -> DeclarationWithArity
forall {a}. (a, Type) -> (a, Arity)
convert (TypedDeclaration -> DeclarationWithArity)
-> [TypedDeclaration] -> [DeclarationWithArity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypedDeclaration]
typedDecls) [DeclarationWithArity]
-> [DeclarationWithArity] -> [DeclarationWithArity]
forall a. Semigroup a => a -> a -> a
<> [DeclarationWithArity
divDecl, DeclarationWithArity
funToPafDecl, DeclarationWithArity
applyDecl]
  where
    convert :: (a, Type) -> (a, Arity)
convert (a
ident, Type
t) = (a
ident, Type -> Arity
calcArity Type
t)

    calcArity :: Type -> Arity
    calcArity :: Type -> Arity
calcArity = (ListF Type Arity -> Arity)
-> (Type -> ListF Type Type) -> Type -> Arity
forall (f :: * -> *) b a.
Functor f =>
(f b -> b) -> (a -> f a) -> a -> b
hylo ListF Type Arity -> Arity
forall a. ListF Type a -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length Type -> ListF Type Type
getParams

    getParams :: Type -> ListF Type Type
    getParams :: Type -> ListF Type Type
getParams (TFun Type
pT Type
retT) = Type -> Type -> ListF Type Type
forall a b. a -> b -> ListF a b
Cons Type
pT Type
retT
    getParams Type
_ = ListF Type Type
forall a b. ListF a b
Nil

-- ** Function Declarations

-- | The @not@ function declaration (@not : bool -> bool@).
notDecl :: TypedDeclaration
notDecl :: TypedDeclaration
notDecl = (Identifier
"not", Type -> Type -> Type
TFun Type
TBool Type
TBool)

-- | The @print_bool@ function declaration (@print_bool : bool -> unit@).
printBoolDecl :: TypedDeclaration
printBoolDecl :: TypedDeclaration
printBoolDecl = (Identifier
"print_bool", Type -> Type -> Type
TFun Type
TBool Type
TUnit)

-- | The @print_int@ function declaration (@print_int : int -> unit@).
printIntDecl :: TypedDeclaration
printIntDecl :: TypedDeclaration
printIntDecl = (Identifier
"print_int", Type -> Type -> Type
TFun Type
TInt Type
TUnit)

-- ** Internal Function Declarations

divDecl :: DeclarationWithArity
divDecl :: DeclarationWithArity
divDecl = (Identifier
"miniml_div", Arity
2)

funToPafDecl :: DeclarationWithArity
funToPafDecl :: DeclarationWithArity
funToPafDecl = (Identifier
"miniml_fun_to_paf", Arity
2)

applyDecl :: DeclarationWithArity
applyDecl :: DeclarationWithArity
applyDecl = (Identifier
"miniml_apply", Arity
2)