aboutsummaryrefslogtreecommitdiffstats
path: root/src/Types.hs
diff options
context:
space:
mode:
authorJan Tuomi <jans.tuomi@gmail.com>2022-09-25 17:52:12 +0300
committerJan Tuomi <jans.tuomi@gmail.com>2022-12-05 14:21:53 +0200
commit6314bf6584f98c735f606155a76c809fd6de5d0b (patch)
tree085d07e116933f23f7db7beaadd03ada1c9dc918 /src/Types.hs
parent218ad3f54ef0be7e0b2e288e543e6c0959ddd7e3 (diff)
Add throwL
Diffstat (limited to 'src/Types.hs')
-rw-r--r--src/Types.hs94
1 files changed, 0 insertions, 94 deletions
diff --git a/src/Types.hs b/src/Types.hs
deleted file mode 100644
index 21a1ceb..0000000
--- a/src/Types.hs
+++ /dev/null
@@ -1,94 +0,0 @@
-{-# OPTIONS_GHC -Wno-missing-export-lists #-}
-module Types 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
-import Utils
-
-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
- _ -> throwError $ LException $ show ast ++ " is not a function"
-
-assertIsASTInteger :: AST -> LContext AST
-assertIsASTInteger ast = case ast of
- (ASTInteger _) -> return ast
- _ -> throwError $ LException $ show ast ++ " is not an integer"
-
-assertIsASTSymbol :: AST -> LContext AST
-assertIsASTSymbol ast = case ast of
- (ASTSymbol _) -> return ast
- _ -> throwError $ LException $ show ast ++ " is not a symbol"
-
-assertIsASTVector :: AST -> LContext AST
-assertIsASTVector ast = case ast of
- (ASTVector _) -> return ast
- _ -> throwError $ LException $ show ast ++ " is not a vector"
-
-assertIsASTFunctionCall :: AST -> LContext AST
-assertIsASTFunctionCall ast = case ast of
- (ASTFunctionCall _) -> return ast
- _ -> throwError $ LException $ show ast ++ " is not a function call or body"