Commit | Line | Data |
---|---|---|
b76aa73b | 1 | module Types |
5400d4bf JM |
2 | (MalVal (..), MalError (..), IOThrows (..), Fn (..), EnvData (..), Env, |
3 | throwStr, throwMalVal, _get_call, _to_list, | |
4 | _func, _malfunc, | |
c150ec41 JM |
5 | _nil_Q, _true_Q, _false_Q, _symbol_Q, _keyword_Q, |
6 | _list_Q, _vector_Q, _hash_map_Q, _atom_Q) | |
b76aa73b JM |
7 | where |
8 | ||
fa9a9758 | 9 | import Data.IORef (IORef) |
b76aa73b | 10 | import qualified Data.Map as Map |
fa9a9758 | 11 | import Control.Exception as CE |
5400d4bf | 12 | import Control.Monad.Error (ErrorT, Error, noMsg, strMsg, throwError) |
b76aa73b | 13 | |
fa9a9758 JM |
14 | |
15 | -- Base Mal types -- | |
5400d4bf | 16 | newtype Fn = Fn ([MalVal] -> IOThrows MalVal) |
b76aa73b JM |
17 | data MalVal = Nil |
18 | | MalFalse | |
19 | | MalTrue | |
20 | | MalNumber Int | |
21 | | MalString String | |
22 | | MalSymbol String | |
c150ec41 JM |
23 | | MalList [MalVal] MalVal |
24 | | MalVector [MalVal] MalVal | |
25 | | MalHashMap (Map.Map String MalVal) MalVal | |
26 | | MalAtom (IORef MalVal) MalVal | |
27 | | Func Fn MalVal | |
28 | | MalFunc {fn :: Fn, | |
29 | ast :: MalVal, | |
30 | env :: Env, | |
31 | params :: MalVal, | |
32 | macro :: Bool, | |
33 | meta :: MalVal} | |
fa9a9758 JM |
34 | |
35 | _equal_Q Nil Nil = True | |
36 | _equal_Q MalFalse MalFalse = True | |
37 | _equal_Q MalTrue MalTrue = True | |
38 | _equal_Q (MalNumber a) (MalNumber b) = a == b | |
39 | _equal_Q (MalString a) (MalString b) = a == b | |
40 | _equal_Q (MalSymbol a) (MalSymbol b) = a == b | |
c150ec41 JM |
41 | _equal_Q (MalList a _) (MalList b _) = a == b |
42 | _equal_Q (MalList a _) (MalVector b _) = a == b | |
43 | _equal_Q (MalVector a _) (MalList b _) = a == b | |
44 | _equal_Q (MalHashMap a _) (MalHashMap b _) = a == b | |
45 | _equal_Q (MalAtom a _) (MalAtom b _) = a == b | |
fa9a9758 | 46 | _equal_Q _ _ = False |
b76aa73b | 47 | |
fa9a9758 JM |
48 | instance Eq MalVal where |
49 | x == y = _equal_Q x y | |
b76aa73b | 50 | |
b76aa73b | 51 | |
5400d4bf JM |
52 | --- Errors/Exceptions --- |
53 | ||
54 | data MalError = StringError String | |
55 | | MalValError MalVal | |
56 | ||
57 | type IOThrows = ErrorT MalError IO | |
58 | ||
59 | instance Error MalError where | |
60 | noMsg = StringError "An error has occurred" | |
61 | strMsg = StringError | |
62 | ||
63 | throwStr str = throwError $ StringError str | |
64 | throwMalVal mv = throwError $ MalValError mv | |
65 | ||
fa9a9758 JM |
66 | -- Env types -- |
67 | -- Note: Env functions are in Env module | |
68 | data EnvData = EnvPair (Maybe Env, (Map.Map String MalVal)) | |
69 | type Env = IORef EnvData | |
b76aa73b | 70 | |
b76aa73b JM |
71 | |
72 | ||
73 | ---------------------------------------------------------- | |
74 | ||
fa9a9758 | 75 | -- General functions -- |
b76aa73b | 76 | |
c150ec41 JM |
77 | _get_call ((Func (Fn f) _) : _) = return f |
78 | _get_call (MalFunc {fn=(Fn f)} : _) = return f | |
5400d4bf | 79 | _get_call _ = throwStr "_get_call first parameter is not a function " |
c150ec41 JM |
80 | |
81 | _to_list (MalList lst _) = return lst | |
82 | _to_list (MalVector lst _) = return lst | |
5400d4bf | 83 | _to_list _ = throwStr "_to_list expected a MalList or MalVector" |
fa9a9758 JM |
84 | |
85 | -- Errors | |
86 | ||
5400d4bf JM |
87 | --catchAny :: IO a -> (CE.SomeException -> IO a) -> IO a |
88 | --catchAny = CE.catch | |
fa9a9758 JM |
89 | |
90 | -- Functions | |
91 | ||
c150ec41 JM |
92 | _func fn = Func (Fn fn) Nil |
93 | _func_meta fn meta = Func (Fn fn) meta | |
94 | ||
fa9a9758 | 95 | _malfunc ast env params fn = MalFunc {fn=(Fn fn), ast=ast, |
2988d38e | 96 | env=env, params=params, |
c150ec41 JM |
97 | macro=False, meta=Nil} |
98 | _malfunc_meta ast env params fn meta = MalFunc {fn=(Fn fn), ast=ast, | |
99 | env=env, params=params, | |
100 | macro=False, meta=meta} | |
101 | ||
102 | -- Scalars | |
103 | _nil_Q Nil = MalTrue | |
104 | _nil_Q _ = MalFalse | |
105 | ||
106 | _true_Q MalTrue = MalTrue | |
107 | _true_Q _ = MalFalse | |
108 | ||
109 | _false_Q MalFalse = MalTrue | |
110 | _false_Q _ = MalFalse | |
111 | ||
112 | _symbol_Q (MalSymbol _) = MalTrue | |
113 | _symbol_Q _ = MalFalse | |
114 | ||
115 | _keyword_Q (MalString ('\x029e':_)) = MalTrue | |
116 | _keyword_Q _ = MalFalse | |
fa9a9758 JM |
117 | |
118 | -- Lists | |
119 | ||
c150ec41 JM |
120 | _list_Q (MalList _ _) = MalTrue |
121 | _list_Q _ = MalFalse | |
fa9a9758 JM |
122 | |
123 | -- Vectors | |
124 | ||
c150ec41 JM |
125 | _vector_Q (MalVector _ _) = MalTrue |
126 | _vector_Q _ = MalFalse | |
fa9a9758 JM |
127 | |
128 | -- Hash Maps | |
129 | ||
c150ec41 JM |
130 | _hash_map_Q (MalHashMap _ _) = MalTrue |
131 | _hash_map_Q _ = MalFalse | |
132 | ||
133 | -- Atoms | |
fa9a9758 | 134 | |
c150ec41 JM |
135 | _atom_Q (MalAtom _ _) = MalTrue |
136 | _atom_Q _ = MalFalse |