-- | Basic functions for working with types and terms

module Hydra.Basics where

import qualified Hydra.Core as Core
import qualified Hydra.Lib.Lists as Lists
import qualified Hydra.Lib.Strings as Strings
import qualified Hydra.Mantle as Mantle
import qualified Hydra.Module as Module
import Data.List
import Data.Map
import Data.Set

-- | Find the elimination variant (constructor) for a given elimination term
eliminationVariant :: (Core.Elimination m -> Mantle.EliminationVariant)
eliminationVariant :: forall m. Elimination m -> EliminationVariant
eliminationVariant Elimination m
x = case Elimination m
x of
  Elimination m
Core.EliminationElement -> EliminationVariant
Mantle.EliminationVariantElement
  Core.EliminationList Term m
_ -> EliminationVariant
Mantle.EliminationVariantList
  Core.EliminationNominal Name
_ -> EliminationVariant
Mantle.EliminationVariantNominal
  Core.EliminationOptional OptionalCases m
_ -> EliminationVariant
Mantle.EliminationVariantOptional
  Core.EliminationRecord Projection
_ -> EliminationVariant
Mantle.EliminationVariantRecord
  Core.EliminationUnion CaseStatement m
_ -> EliminationVariant
Mantle.EliminationVariantUnion

-- | All elimination variants (constructors), in a canonical order
eliminationVariants :: [Mantle.EliminationVariant]
eliminationVariants :: [EliminationVariant]
eliminationVariants = [
  EliminationVariant
Mantle.EliminationVariantElement,
  EliminationVariant
Mantle.EliminationVariantList,
  EliminationVariant
Mantle.EliminationVariantNominal,
  EliminationVariant
Mantle.EliminationVariantOptional,
  EliminationVariant
Mantle.EliminationVariantRecord,
  EliminationVariant
Mantle.EliminationVariantUnion]

-- | Find the precision of a given floating-point type
floatTypePrecision :: (Core.FloatType -> Mantle.Precision)
floatTypePrecision :: FloatType -> Precision
floatTypePrecision FloatType
x = case FloatType
x of
  FloatType
Core.FloatTypeBigfloat -> Precision
Mantle.PrecisionArbitrary
  FloatType
Core.FloatTypeFloat32 -> (Int -> Precision
Mantle.PrecisionBits Int
32)
  FloatType
Core.FloatTypeFloat64 -> (Int -> Precision
Mantle.PrecisionBits Int
64)

-- | All floating-point types in a canonical order
floatTypes :: [Core.FloatType]
floatTypes :: [FloatType]
floatTypes = [
  FloatType
Core.FloatTypeBigfloat,
  FloatType
Core.FloatTypeFloat32,
  FloatType
Core.FloatTypeFloat64]

-- | Find the float type for a given floating-point value
floatValueType :: (Core.FloatValue -> Core.FloatType)
floatValueType :: FloatValue -> FloatType
floatValueType FloatValue
x = case FloatValue
x of
  Core.FloatValueBigfloat Double
_ -> FloatType
Core.FloatTypeBigfloat
  Core.FloatValueFloat32 Float
_ -> FloatType
Core.FloatTypeFloat32
  Core.FloatValueFloat64 Double
_ -> FloatType
Core.FloatTypeFloat64

-- | Find the function variant (constructor) for a given function
functionVariant :: (Core.Function m -> Mantle.FunctionVariant)
functionVariant :: forall m. Function m -> FunctionVariant
functionVariant Function m
x = case Function m
x of
  Core.FunctionCompareTo Term m
_ -> FunctionVariant
Mantle.FunctionVariantCompareTo
  Core.FunctionElimination Elimination m
_ -> FunctionVariant
Mantle.FunctionVariantElimination
  Core.FunctionLambda Lambda m
_ -> FunctionVariant
Mantle.FunctionVariantLambda
  Core.FunctionPrimitive Name
_ -> FunctionVariant
Mantle.FunctionVariantPrimitive

-- | All function variants (constructors), in a canonical order
functionVariants :: [Mantle.FunctionVariant]
functionVariants :: [FunctionVariant]
functionVariants = [
  FunctionVariant
Mantle.FunctionVariantCompareTo,
  FunctionVariant
Mantle.FunctionVariantElimination,
  FunctionVariant
Mantle.FunctionVariantLambda,
  FunctionVariant
Mantle.FunctionVariantPrimitive]

-- | Find whether a given integer type is signed (true) or unsigned (false)
integerTypeIsSigned :: (Core.IntegerType -> Bool)
integerTypeIsSigned :: IntegerType -> Bool
integerTypeIsSigned IntegerType
x = case IntegerType
x of
  IntegerType
Core.IntegerTypeBigint -> Bool
True
  IntegerType
Core.IntegerTypeInt8 -> Bool
True
  IntegerType
Core.IntegerTypeInt16 -> Bool
True
  IntegerType
Core.IntegerTypeInt32 -> Bool
True
  IntegerType
Core.IntegerTypeInt64 -> Bool
True
  IntegerType
Core.IntegerTypeUint8 -> Bool
False
  IntegerType
Core.IntegerTypeUint16 -> Bool
False
  IntegerType
Core.IntegerTypeUint32 -> Bool
False
  IntegerType
Core.IntegerTypeUint64 -> Bool
False

-- | Find the precision of a given integer type
integerTypePrecision :: (Core.IntegerType -> Mantle.Precision)
integerTypePrecision :: IntegerType -> Precision
integerTypePrecision IntegerType
x = case IntegerType
x of
  IntegerType
Core.IntegerTypeBigint -> Precision
Mantle.PrecisionArbitrary
  IntegerType
Core.IntegerTypeInt8 -> (Int -> Precision
Mantle.PrecisionBits Int
8)
  IntegerType
Core.IntegerTypeInt16 -> (Int -> Precision
Mantle.PrecisionBits Int
16)
  IntegerType
Core.IntegerTypeInt32 -> (Int -> Precision
Mantle.PrecisionBits Int
32)
  IntegerType
Core.IntegerTypeInt64 -> (Int -> Precision
Mantle.PrecisionBits Int
64)
  IntegerType
Core.IntegerTypeUint8 -> (Int -> Precision
Mantle.PrecisionBits Int
8)
  IntegerType
Core.IntegerTypeUint16 -> (Int -> Precision
Mantle.PrecisionBits Int
16)
  IntegerType
Core.IntegerTypeUint32 -> (Int -> Precision
Mantle.PrecisionBits Int
32)
  IntegerType
Core.IntegerTypeUint64 -> (Int -> Precision
Mantle.PrecisionBits Int
64)

-- | All integer types, in a canonical order
integerTypes :: [Core.IntegerType]
integerTypes :: [IntegerType]
integerTypes = [
  IntegerType
Core.IntegerTypeBigint,
  IntegerType
Core.IntegerTypeInt8,
  IntegerType
Core.IntegerTypeInt16,
  IntegerType
Core.IntegerTypeInt32,
  IntegerType
Core.IntegerTypeInt64,
  IntegerType
Core.IntegerTypeUint8,
  IntegerType
Core.IntegerTypeUint16,
  IntegerType
Core.IntegerTypeUint32,
  IntegerType
Core.IntegerTypeUint64]

-- | Find the integer type for a given integer value
integerValueType :: (Core.IntegerValue -> Core.IntegerType)
integerValueType :: IntegerValue -> IntegerType
integerValueType IntegerValue
x = case IntegerValue
x of
  Core.IntegerValueBigint Integer
_ -> IntegerType
Core.IntegerTypeBigint
  Core.IntegerValueInt8 Int
_ -> IntegerType
Core.IntegerTypeInt8
  Core.IntegerValueInt16 Int
_ -> IntegerType
Core.IntegerTypeInt16
  Core.IntegerValueInt32 Int
_ -> IntegerType
Core.IntegerTypeInt32
  Core.IntegerValueInt64 Integer
_ -> IntegerType
Core.IntegerTypeInt64
  Core.IntegerValueUint8 Int
_ -> IntegerType
Core.IntegerTypeUint8
  Core.IntegerValueUint16 Int
_ -> IntegerType
Core.IntegerTypeUint16
  Core.IntegerValueUint32 Integer
_ -> IntegerType
Core.IntegerTypeUint32
  Core.IntegerValueUint64 Integer
_ -> IntegerType
Core.IntegerTypeUint64

-- | Find the literal type for a given literal value
literalType :: (Core.Literal -> Core.LiteralType)
literalType :: Literal -> LiteralType
literalType Literal
x = case Literal
x of
  Core.LiteralBinary String
_ -> LiteralType
Core.LiteralTypeBinary
  Core.LiteralBoolean Bool
_ -> LiteralType
Core.LiteralTypeBoolean
  Core.LiteralFloat FloatValue
v -> ((\FloatType
x2 -> FloatType -> LiteralType
Core.LiteralTypeFloat FloatType
x2) (FloatValue -> FloatType
floatValueType FloatValue
v))
  Core.LiteralInteger IntegerValue
v -> ((\IntegerType
x2 -> IntegerType -> LiteralType
Core.LiteralTypeInteger IntegerType
x2) (IntegerValue -> IntegerType
integerValueType IntegerValue
v))
  Core.LiteralString String
_ -> LiteralType
Core.LiteralTypeString

-- | Find the literal type variant (constructor) for a given literal value
literalTypeVariant :: (Core.LiteralType -> Mantle.LiteralVariant)
literalTypeVariant :: LiteralType -> LiteralVariant
literalTypeVariant LiteralType
x = case LiteralType
x of
  LiteralType
Core.LiteralTypeBinary -> LiteralVariant
Mantle.LiteralVariantBinary
  LiteralType
Core.LiteralTypeBoolean -> LiteralVariant
Mantle.LiteralVariantBoolean
  Core.LiteralTypeFloat FloatType
_ -> LiteralVariant
Mantle.LiteralVariantFloat
  Core.LiteralTypeInteger IntegerType
_ -> LiteralVariant
Mantle.LiteralVariantInteger
  LiteralType
Core.LiteralTypeString -> LiteralVariant
Mantle.LiteralVariantString

-- | Find the literal variant (constructor) for a given literal value
literalVariant :: (Core.Literal -> Mantle.LiteralVariant)
literalVariant :: Literal -> LiteralVariant
literalVariant Literal
x1 = (LiteralType -> LiteralVariant
literalTypeVariant (Literal -> LiteralType
literalType Literal
x1))

-- | All literal variants, in a canonical order
literalVariants :: [Mantle.LiteralVariant]
literalVariants :: [LiteralVariant]
literalVariants = [
  LiteralVariant
Mantle.LiteralVariantBinary,
  LiteralVariant
Mantle.LiteralVariantBoolean,
  LiteralVariant
Mantle.LiteralVariantFloat,
  LiteralVariant
Mantle.LiteralVariantInteger,
  LiteralVariant
Mantle.LiteralVariantString]

-- | 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]))

-- | Find the term variant (constructor) for a given term
termVariant :: (Core.Term m -> Mantle.TermVariant)
termVariant :: forall m. Term m -> TermVariant
termVariant Term m
term = ((\Term m
x -> case Term m
x of
  Core.TermAnnotated Annotated (Term m) m
_ -> TermVariant
Mantle.TermVariantAnnotated
  Core.TermApplication Application m
_ -> TermVariant
Mantle.TermVariantApplication
  Core.TermElement Name
_ -> TermVariant
Mantle.TermVariantElement
  Core.TermFunction Function m
_ -> TermVariant
Mantle.TermVariantFunction
  Core.TermLet Let m
_ -> TermVariant
Mantle.TermVariantLet
  Core.TermList [Term m]
_ -> TermVariant
Mantle.TermVariantList
  Core.TermLiteral Literal
_ -> TermVariant
Mantle.TermVariantLiteral
  Core.TermMap Map (Term m) (Term m)
_ -> TermVariant
Mantle.TermVariantMap
  Core.TermNominal Named m
_ -> TermVariant
Mantle.TermVariantNominal
  Core.TermOptional Maybe (Term m)
_ -> TermVariant
Mantle.TermVariantOptional
  Core.TermProduct [Term m]
_ -> TermVariant
Mantle.TermVariantProduct
  Core.TermRecord Record m
_ -> TermVariant
Mantle.TermVariantRecord
  Core.TermSet Set (Term m)
_ -> TermVariant
Mantle.TermVariantSet
  Core.TermStream Stream m
_ -> TermVariant
Mantle.TermVariantStream
  Core.TermSum Sum m
_ -> TermVariant
Mantle.TermVariantSum
  Core.TermUnion Union m
_ -> TermVariant
Mantle.TermVariantUnion
  Core.TermVariable Variable
_ -> TermVariant
Mantle.TermVariantVariable) Term m
term)

-- | All term (expression) variants, in a canonical order
termVariants :: [Mantle.TermVariant]
termVariants :: [TermVariant]
termVariants = [
  TermVariant
Mantle.TermVariantAnnotated,
  TermVariant
Mantle.TermVariantApplication,
  TermVariant
Mantle.TermVariantLiteral,
  TermVariant
Mantle.TermVariantElement,
  TermVariant
Mantle.TermVariantFunction,
  TermVariant
Mantle.TermVariantList,
  TermVariant
Mantle.TermVariantMap,
  TermVariant
Mantle.TermVariantNominal,
  TermVariant
Mantle.TermVariantOptional,
  TermVariant
Mantle.TermVariantProduct,
  TermVariant
Mantle.TermVariantRecord,
  TermVariant
Mantle.TermVariantSet,
  TermVariant
Mantle.TermVariantStream,
  TermVariant
Mantle.TermVariantSum,
  TermVariant
Mantle.TermVariantUnion,
  TermVariant
Mantle.TermVariantVariable]

-- | TODO: temporary. Just a token polymorphic function for testing
testLists :: ([[a]] -> Int)
testLists :: forall a. [[a]] -> Int
testLists [[a]]
els = (forall a. [a] -> Int
Lists.length (forall a. [[a]] -> [a]
Lists.concat [[a]]
els))

-- | Find the type variant (constructor) for a given type
typeVariant :: (Core.Type m -> Mantle.TypeVariant)
typeVariant :: forall m. Type m -> TypeVariant
typeVariant Type m
typ = ((\Type m
x -> case Type m
x of
  Core.TypeAnnotated Annotated (Type m) m
_ -> TypeVariant
Mantle.TypeVariantAnnotated
  Core.TypeApplication ApplicationType m
_ -> TypeVariant
Mantle.TypeVariantApplication
  Core.TypeElement Type m
_ -> TypeVariant
Mantle.TypeVariantElement
  Core.TypeFunction FunctionType m
_ -> TypeVariant
Mantle.TypeVariantFunction
  Core.TypeLambda LambdaType m
_ -> TypeVariant
Mantle.TypeVariantLambda
  Core.TypeList Type m
_ -> TypeVariant
Mantle.TypeVariantList
  Core.TypeLiteral LiteralType
_ -> TypeVariant
Mantle.TypeVariantLiteral
  Core.TypeMap MapType m
_ -> TypeVariant
Mantle.TypeVariantMap
  Core.TypeNominal Name
_ -> TypeVariant
Mantle.TypeVariantNominal
  Core.TypeOptional Type m
_ -> TypeVariant
Mantle.TypeVariantOptional
  Core.TypeProduct [Type m]
_ -> TypeVariant
Mantle.TypeVariantProduct
  Core.TypeRecord RowType m
_ -> TypeVariant
Mantle.TypeVariantRecord
  Core.TypeSet Type m
_ -> TypeVariant
Mantle.TypeVariantSet
  Core.TypeStream Type m
_ -> TypeVariant
Mantle.TypeVariantStream
  Core.TypeSum [Type m]
_ -> TypeVariant
Mantle.TypeVariantSum
  Core.TypeUnion RowType m
_ -> TypeVariant
Mantle.TypeVariantUnion
  Core.TypeVariable VariableType
_ -> TypeVariant
Mantle.TypeVariantVariable) Type m
typ)

-- | All type variants, in a canonical order
typeVariants :: [Mantle.TypeVariant]
typeVariants :: [TypeVariant]
typeVariants = [
  TypeVariant
Mantle.TypeVariantAnnotated,
  TypeVariant
Mantle.TypeVariantApplication,
  TypeVariant
Mantle.TypeVariantElement,
  TypeVariant
Mantle.TypeVariantFunction,
  TypeVariant
Mantle.TypeVariantLambda,
  TypeVariant
Mantle.TypeVariantList,
  TypeVariant
Mantle.TypeVariantLiteral,
  TypeVariant
Mantle.TypeVariantMap,
  TypeVariant
Mantle.TypeVariantNominal,
  TypeVariant
Mantle.TypeVariantOptional,
  TypeVariant
Mantle.TypeVariantProduct,
  TypeVariant
Mantle.TypeVariantRecord,
  TypeVariant
Mantle.TypeVariantSet,
  TypeVariant
Mantle.TypeVariantStream,
  TypeVariant
Mantle.TypeVariantSum,
  TypeVariant
Mantle.TypeVariantUnion,
  TypeVariant
Mantle.TypeVariantVariable]