-- | Basic functions which depend on primitive functions

module Hydra.Extras where

import qualified Hydra.Core as Core
import qualified Hydra.Graph as Graph
import qualified Hydra.Lib.Lists as Lists
import qualified Hydra.Lib.Maps as Maps
import qualified Hydra.Lib.Math as Math
import qualified Hydra.Lib.Strings as Strings
import qualified Hydra.Module as Module
import Data.Int
import Data.List as L
import Data.Map as M
import Data.Set as S

functionArity :: (Core.Function -> Int)
functionArity :: Function -> Int
functionArity Function
x = case Function
x of
  Core.FunctionElimination Elimination
_ -> Int
1
  Core.FunctionLambda Lambda
v275 -> (Int -> Int -> Int
Math.add Int
1 (Term -> Int
termArity (Lambda -> Term
Core.lambdaBody Lambda
v275)))
  Core.FunctionPrimitive Name
_ -> Int
42

lookupPrimitive :: (Graph.Graph -> Core.Name -> Maybe Graph.Primitive)
lookupPrimitive :: Graph -> Name -> Maybe Primitive
lookupPrimitive Graph
g Name
name = (Name -> Map Name Primitive -> Maybe Primitive
forall k v. Ord k => k -> Map k v -> Maybe v
Maps.lookup Name
name (Graph -> Map Name Primitive
Graph.graphPrimitives Graph
g))

-- | Find the arity (expected number of arguments) of a primitive constant or function
primitiveArity :: (Graph.Primitive -> Int)
primitiveArity :: Primitive -> Int
primitiveArity Primitive
x = ((\TypeScheme
x -> Type -> Int
typeArity (TypeScheme -> Type
Core.typeSchemeType TypeScheme
x)) (Primitive -> TypeScheme
Graph.primitiveType Primitive
x))

-- | Construct a qualified (dot-separated) name
qname :: (Module.Namespace -> String -> Core.Name)
qname :: Namespace -> String -> Name
qname Namespace
ns String
name = (String -> Name
Core.Name ([String] -> String
Strings.cat [
  Namespace -> String
Module.unNamespace Namespace
ns,
  String
".",
  String
name]))

termArity :: (Core.Term -> Int)
termArity :: Term -> Int
termArity Term
x = case Term
x of
  Core.TermApplication Application
v277 -> ((\Term
x -> (\Int
x -> Int -> Int -> Int
Math.sub Int
x Int
1) (Term -> Int
termArity Term
x)) (Application -> Term
Core.applicationFunction Application
v277))
  Core.TermFunction Function
v278 -> (Function -> Int
functionArity Function
v278)
  Term
_ -> Int
0

typeArity :: (Core.Type -> Int)
typeArity :: Type -> Int
typeArity Type
x = case Type
x of
  Core.TypeAnnotated AnnotatedType
v279 -> (Type -> Int
typeArity (AnnotatedType -> Type
Core.annotatedTypeSubject AnnotatedType
v279))
  Core.TypeApplication ApplicationType
v280 -> (Type -> Int
typeArity (ApplicationType -> Type
Core.applicationTypeFunction ApplicationType
v280))
  Core.TypeLambda LambdaType
v281 -> (Type -> Int
typeArity (LambdaType -> Type
Core.lambdaTypeBody LambdaType
v281))
  Core.TypeFunction FunctionType
v282 -> (Int -> Int -> Int
Math.add Int
1 (Type -> Int
typeArity (FunctionType -> Type
Core.functionTypeCodomain FunctionType
v282)))
  Type
_ -> Int
0

-- | Uncurry a type expression into a list of types, turning a function type a -> b into cons a (uncurryType b)
uncurryType :: (Core.Type -> [Core.Type])
uncurryType :: Type -> [Type]
uncurryType Type
t = ((\Type
x -> case Type
x of
  Core.TypeAnnotated AnnotatedType
v283 -> (Type -> [Type]
uncurryType (AnnotatedType -> Type
Core.annotatedTypeSubject AnnotatedType
v283))
  Core.TypeApplication ApplicationType
v284 -> (Type -> [Type]
uncurryType (ApplicationType -> Type
Core.applicationTypeFunction ApplicationType
v284))
  Core.TypeLambda LambdaType
v285 -> (Type -> [Type]
uncurryType (LambdaType -> Type
Core.lambdaTypeBody LambdaType
v285))
  Core.TypeFunction FunctionType
v286 -> (Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
Lists.cons (FunctionType -> Type
Core.functionTypeDomain FunctionType
v286) (Type -> [Type]
uncurryType (FunctionType -> Type
Core.functionTypeCodomain FunctionType
v286)))
  Type
_ -> [
    Type
t]) Type
t)

getAnnotation :: (Core.Name -> Map Core.Name Core.Term -> Maybe Core.Term)
getAnnotation :: Name -> Map Name Term -> Maybe Term
getAnnotation Name
key Map Name Term
ann = (Name -> Map Name Term -> Maybe Term
forall k v. Ord k => k -> Map k v -> Maybe v
Maps.lookup Name
key Map Name Term
ann)