aboutsummaryrefslogtreecommitdiffstats
path: root/src/Utils.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Utils.hs')
-rw-r--r--src/Utils.hs101
1 files changed, 100 insertions, 1 deletions
diff --git a/src/Utils.hs b/src/Utils.hs
index d2068d4..fe0a9c2 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -1,8 +1,104 @@
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
-{-# OPTIONS_GHC -Wno-missing-signatures #-}
module Utils where
+import Control.Monad.Except
+import Control.Monad.Reader
+import qualified Data.Map as M
+import qualified Data.List as L
+import qualified Data.Char as C
+
+-- TYPES
+
+newtype LException = LException String
+data Config = Config {
+ configScriptFileName :: Maybe String,
+ configVerboseMode :: Bool,
+ configShowHelp :: Bool
+}
+
+type LContext a = ReaderT Config (ExceptT LException IO) a
+
+type Env = M.Map String AST
+
+type LFunction = (Env -> AST -> LContext AST)
+
+data AST
+ = ASTInteger Int
+ | ASTDouble Double
+ | ASTSymbol String
+ | ASTBoolean Bool
+ | ASTString String
+ | ASTVector [AST]
+ | ASTFunctionCall [AST]
+ | ASTHashMap (M.Map AST AST)
+ | ASTFunction LFunction
+ | ASTUnit
+
+instance (Show AST) where
+ show (ASTInteger n) = show n
+ show (ASTDouble n) = show n
+ show (ASTSymbol s) = s
+ show (ASTBoolean b) = show b $> map C.toLower
+ show (ASTString s) = show s
+ show (ASTVector v) = "[" ++ L.intercalate " " (map show v) ++ "]"
+ show (ASTFunctionCall v) = "(" ++ L.intercalate " " (map show v) ++ ")"
+ show (ASTHashMap m) =
+ let flattenMap = M.assocs .> L.concatMap (\(k, v) -> [k, v])
+ in "{" ++ L.intercalate " " (map show $ flattenMap m) ++ "}"
+ show (ASTFunction _) = "<fn>"
+ show ASTUnit = "<unit>"
+
+instance (Eq AST) where
+ ASTInteger a == ASTInteger b = a == b
+ ASTDouble a == ASTDouble b = a == b
+ ASTSymbol a == ASTSymbol b = a == b
+ ASTBoolean a == ASTBoolean b = a == b
+ ASTString a == ASTString b = a == b
+ ASTVector a == ASTVector b = a == b
+ ASTHashMap a == ASTHashMap b = a == b
+ ASTUnit == ASTUnit = True
+ _ == _ = False
+
+instance (Ord AST) where
+ ASTInteger a <= ASTInteger b = a <= b
+ ASTDouble a <= ASTDouble b = a <= b
+ ASTSymbol a <= ASTSymbol b = a <= b
+ ASTBoolean a <= ASTBoolean b = a <= b
+ ASTString a <= ASTString b = a <= b
+ ASTVector a <= ASTVector b = a <= b
+ ASTHashMap a <= ASTHashMap b = a <= b
+ _ <= _ = False
+
+assertIsASTFunction :: AST -> LContext AST
+assertIsASTFunction ast = case ast of
+ (ASTFunction _) -> return ast
+ _ -> throwL $ show ast ++ " is not a function"
+
+assertIsASTInteger :: AST -> LContext AST
+assertIsASTInteger ast = case ast of
+ (ASTInteger _) -> return ast
+ _ -> throwL $ show ast ++ " is not an integer"
+
+assertIsASTSymbol :: AST -> LContext AST
+assertIsASTSymbol ast = case ast of
+ (ASTSymbol _) -> return ast
+ _ -> throwL $ show ast ++ " is not a symbol"
+
+assertIsASTVector :: AST -> LContext AST
+assertIsASTVector ast = case ast of
+ (ASTVector _) -> return ast
+ _ -> throwL $ show ast ++ " is not a vector"
+
+assertIsASTFunctionCall :: AST -> LContext AST
+assertIsASTFunctionCall ast = case ast of
+ (ASTFunctionCall _) -> return ast
+ _ -> throwL $ show ast ++ " is not a function call or body"
+
+-- UTILS
+
+(.>) :: (a -> b) -> (b -> c) -> a -> c
(.>) = flip (.)
+($>) :: b -> (b -> c) -> c
($>) = flip ($)
infixr 6 $>
@@ -14,3 +110,6 @@ oddElems (x:xs) = x:evenElems xs
evenElems :: [a] -> [a]
evenElems [] = []
evenElems (_:xs) = oddElems xs
+
+throwL :: String -> LContext a
+throwL s = throwError $ LException s