-- | 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
v232 -> (Int -> Int -> Int
Math.add Int
1 (Term -> Int
termArity (Lambda -> Term
Core.lambdaBody Lambda
v232)))
  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 = (Type -> Int
typeArity (Primitive -> Type
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
v234 -> ((\Int
x -> Int -> Int -> Int
Math.sub Int
x Int
1) (Term -> Int
termArity (Application -> Term
Core.applicationFunction Application
v234)))
  Core.TermFunction Function
v235 -> (Function -> Int
functionArity Function
v235)
  Term
_ -> Int
0

typeArity :: (Core.Type -> Int)
typeArity :: Type -> Int
typeArity Type
x = case Type
x of
  Core.TypeAnnotated AnnotatedType
v236 -> (Type -> Int
typeArity (AnnotatedType -> Type
Core.annotatedTypeSubject AnnotatedType
v236))
  Core.TypeApplication ApplicationType
v237 -> (Type -> Int
typeArity (ApplicationType -> Type
Core.applicationTypeFunction ApplicationType
v237))
  Core.TypeLambda LambdaType
v238 -> (Type -> Int
typeArity (LambdaType -> Type
Core.lambdaTypeBody LambdaType
v238))
  Core.TypeFunction FunctionType
v239 -> (Int -> Int -> Int
Math.add Int
1 (Type -> Int
typeArity (FunctionType -> Type
Core.functionTypeCodomain FunctionType
v239)))
  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
v240 -> (Type -> [Type]
uncurryType (AnnotatedType -> Type
Core.annotatedTypeSubject AnnotatedType
v240))
  Core.TypeApplication ApplicationType
v241 -> (Type -> [Type]
uncurryType (ApplicationType -> Type
Core.applicationTypeFunction ApplicationType
v241))
  Core.TypeLambda LambdaType
v242 -> (Type -> [Type]
uncurryType (LambdaType -> Type
Core.lambdaTypeBody LambdaType
v242))
  Core.TypeFunction FunctionType
v243 -> (Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
Lists.cons (FunctionType -> Type
Core.functionTypeDomain FunctionType
v243) (Type -> [Type]
uncurryType (FunctionType -> Type
Core.functionTypeCodomain FunctionType
v243)))
  Type
_ -> [
    Type
t]) Type
t)

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