module Language.CalDims.State
( MyParser
, Arg (..)
, Args
, Scope
, State (..)
, StateEntry (..)
, isBasicUnit
, isUnit
, isDerivedUnit
, isFunction
, isBuiltin
, lu
, start) where
import qualified Data.Map as Map
import qualified Data.List as List
import Data.Maybe
import Language.CalDims.Types
import Language.CalDims.Expr ()
start :: State
start = State
{ getScope = Map.fromList [ (Name "pi", Builtin [] $ Evaled (toRational ((pi)::Double), noDims))
, (Name "e", Builtin [] $ Evaled (toRational ((exp 1):: Double), noDims))
, (Name "exp", bUni Expot noDims)
, (Name "log", bUni Log noDims)
, (Name "cos", bUni Cos noDims)
, (Name "tan", bUni Tan noDims)
, (Name "asin", bUni Asin noDims)
, (Name "acos", bUni Acos noDims)
, (Name "atan", bUni Atan noDims)
, (Name "sinh", bUni Sinh noDims)
, (Name "cosh", bUni Cosh noDims)
, (Name "tanh", bUni Tanh noDims)
, (Name "asinh", bUni Asinh noDims)
, (Name "acosh", bUni Acosh noDims)
, (Name "atanh", bUni Atanh noDims)
, (Name "sin", bUni Sin noDims)]
, getArgs = []
, getArgValues = []}
bUni :: UniOp -> Dims -> StateEntry
bUni o d = let arg = Arg "x" 0 d in Builtin [arg] $ Uni o (ArgRef arg)
instance Pretty (Name, StateEntry) where
pretty (name, Function args expr) = pretty name ++ prettyArgs args ++ " = " ++ pretty expr
pretty (name, Builtin args _) = pretty name ++ prettyArgs args ++ " = [[builtin]]"
pretty (name, Dimension expr) = pretty name ++ " := " ++ pretty expr
pretty (name, BasicDimension) = "\\u " ++ pretty name
prettyArgs :: Args -> String
prettyArgs [] = ""
prettyArgs args = " (" ++ foldl1 (\a b -> a ++ ", " ++ b) (map (\ (Arg n _ d) -> n ++ " : " ++ pretty d) args) ++ ")"
isBasicUnit, isUnit, isDerivedUnit, isFunction, isBuiltin :: State -> Name -> Bool
isBasicUnit state name
| Just BasicDimension <- lu name state = True
| otherwise = False
isFunction state name
| Just (Function _ _) <- lu name state = True
| otherwise = False
isBuiltin state name
| Just (Builtin _ _) <- lu name state = True
| otherwise = False
isDerivedUnit state name
| Just (Dimension _) <- lu name state = True
| otherwise = False
isUnit state name = isDerivedUnit state name || isBasicUnit state name
lu :: Name -> State -> Maybe StateEntry
lu name state = Map.lookup name (getScope state)