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, | |
defa41f3 | 5 | _nil_Q, _true_Q, _false_Q, _string_Q, _symbol_Q, _keyword_Q, |
c150ec41 | 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 | |
c46b421a | 44 | _equal_Q (MalVector a _) (MalVector b _) = a == b |
c150ec41 JM |
45 | _equal_Q (MalHashMap a _) (MalHashMap b _) = a == b |
46 | _equal_Q (MalAtom a _) (MalAtom b _) = a == b | |
fa9a9758 | 47 | _equal_Q _ _ = False |
b76aa73b | 48 | |
fa9a9758 JM |
49 | instance Eq MalVal where |
50 | x == y = _equal_Q x y | |
b76aa73b | 51 | |
b76aa73b | 52 | |
5400d4bf JM |
53 | --- Errors/Exceptions --- |
54 | ||
55 | data MalError = StringError String | |
56 | | MalValError MalVal | |
57 | ||
58 | type IOThrows = ErrorT MalError IO | |
59 | ||
60 | instance Error MalError where | |
61 | noMsg = StringError "An error has occurred" | |
62 | strMsg = StringError | |
63 | ||
64 | throwStr str = throwError $ StringError str | |
65 | throwMalVal mv = throwError $ MalValError mv | |
66 | ||
fa9a9758 JM |
67 | -- Env types -- |
68 | -- Note: Env functions are in Env module | |
69 | data EnvData = EnvPair (Maybe Env, (Map.Map String MalVal)) | |
70 | type Env = IORef EnvData | |
b76aa73b | 71 | |
b76aa73b JM |
72 | |
73 | ||
74 | ---------------------------------------------------------- | |
75 | ||
fa9a9758 | 76 | -- General functions -- |
b76aa73b | 77 | |
c150ec41 JM |
78 | _get_call ((Func (Fn f) _) : _) = return f |
79 | _get_call (MalFunc {fn=(Fn f)} : _) = return f | |
5400d4bf | 80 | _get_call _ = throwStr "_get_call first parameter is not a function " |
c150ec41 JM |
81 | |
82 | _to_list (MalList lst _) = return lst | |
83 | _to_list (MalVector lst _) = return lst | |
5400d4bf | 84 | _to_list _ = throwStr "_to_list expected a MalList or MalVector" |
fa9a9758 JM |
85 | |
86 | -- Errors | |
87 | ||
5400d4bf JM |
88 | --catchAny :: IO a -> (CE.SomeException -> IO a) -> IO a |
89 | --catchAny = CE.catch | |
fa9a9758 JM |
90 | |
91 | -- Functions | |
92 | ||
c150ec41 JM |
93 | _func fn = Func (Fn fn) Nil |
94 | _func_meta fn meta = Func (Fn fn) meta | |
95 | ||
fa9a9758 | 96 | _malfunc ast env params fn = MalFunc {fn=(Fn fn), ast=ast, |
2988d38e | 97 | env=env, params=params, |
c150ec41 JM |
98 | macro=False, meta=Nil} |
99 | _malfunc_meta ast env params fn meta = MalFunc {fn=(Fn fn), ast=ast, | |
100 | env=env, params=params, | |
101 | macro=False, meta=meta} | |
102 | ||
103 | -- Scalars | |
104 | _nil_Q Nil = MalTrue | |
105 | _nil_Q _ = MalFalse | |
106 | ||
107 | _true_Q MalTrue = MalTrue | |
108 | _true_Q _ = MalFalse | |
109 | ||
110 | _false_Q MalFalse = MalTrue | |
111 | _false_Q _ = MalFalse | |
112 | ||
113 | _symbol_Q (MalSymbol _) = MalTrue | |
114 | _symbol_Q _ = MalFalse | |
115 | ||
defa41f3 JM |
116 | _string_Q (MalString ('\x029e':_)) = MalFalse |
117 | _string_Q (MalString _) = MalTrue | |
118 | _string_Q _ = MalFalse | |
119 | ||
c150ec41 JM |
120 | _keyword_Q (MalString ('\x029e':_)) = MalTrue |
121 | _keyword_Q _ = MalFalse | |
fa9a9758 JM |
122 | |
123 | -- Lists | |
124 | ||
c150ec41 JM |
125 | _list_Q (MalList _ _) = MalTrue |
126 | _list_Q _ = MalFalse | |
fa9a9758 JM |
127 | |
128 | -- Vectors | |
129 | ||
c150ec41 JM |
130 | _vector_Q (MalVector _ _) = MalTrue |
131 | _vector_Q _ = MalFalse | |
fa9a9758 JM |
132 | |
133 | -- Hash Maps | |
134 | ||
c150ec41 JM |
135 | _hash_map_Q (MalHashMap _ _) = MalTrue |
136 | _hash_map_Q _ = MalFalse | |
137 | ||
138 | -- Atoms | |
fa9a9758 | 139 | |
c150ec41 JM |
140 | _atom_Q (MalAtom _ _) = MalTrue |
141 | _atom_Q _ = MalFalse |