| 1 | Imports System |
| 2 | Imports System.IO |
| 3 | Imports System.Collections.Generic |
| 4 | Imports Mal |
| 5 | Imports MalVal = Mal.types.MalVal |
| 6 | Imports MalInt = Mal.types.MalInt |
| 7 | Imports MalString = Mal.types.MalString |
| 8 | Imports MalSymbol = Mal.types.MalSymbol |
| 9 | Imports MalList = Mal.types.MalList |
| 10 | Imports MalVector = Mal.types.MalVector |
| 11 | Imports MalHashMap = Mal.types.MalHashMap |
| 12 | Imports MalFunc = Mal.types.MalFunc |
| 13 | Imports MalEnv = Mal.env.Env |
| 14 | |
| 15 | Namespace Mal |
| 16 | Class stepA_mal |
| 17 | ' read |
| 18 | Shared Function READ(str As String) As MalVal |
| 19 | Return reader.read_str(str) |
| 20 | End Function |
| 21 | |
| 22 | ' eval |
| 23 | Shared Function is_pair(x As MalVal) As Boolean |
| 24 | return TypeOf x Is MalList AndAlso _ |
| 25 | DirectCast(x,MalList).size() > 0 |
| 26 | End Function |
| 27 | |
| 28 | Shared Function quasiquote(ast As MalVal) As MalVal |
| 29 | If not is_pair(ast) Then |
| 30 | return New MalList(New MalSymbol("quote"), ast) |
| 31 | Else |
| 32 | Dim a0 As MalVal = DirectCast(ast,MalList)(0) |
| 33 | If TypeOf a0 Is MalSymbol AndAlso _ |
| 34 | DirectCast(a0,MalSymbol).getName() = "unquote" Then |
| 35 | return DirectCast(ast,MalList)(1) |
| 36 | Else If is_pair(a0) Then |
| 37 | Dim a00 As MalVal = DirectCast(a0,MalList)(0) |
| 38 | If TypeOf a00 is MalSymbol AndAlso _ |
| 39 | DirectCast(a00,MalSymbol).getName() = "splice-unquote" Then |
| 40 | return New MalList(New MalSymbol("concat"), |
| 41 | DirectCast(a0,MalList)(1), |
| 42 | quasiquote(DirectCast(ast,MalList).rest())) |
| 43 | End If |
| 44 | End If |
| 45 | return New MalList(New MalSymbol("cons"), |
| 46 | quasiquote(a0), |
| 47 | quasiquote(DirectCast(ast,MalList).rest())) |
| 48 | End If |
| 49 | End Function |
| 50 | |
| 51 | Shared Function is_macro_call(ast As MalVal, env As MalEnv) As Boolean |
| 52 | If TypeOf ast Is MalList Then |
| 53 | Dim a0 As MalVal = DirectCast(ast,MalList)(0) |
| 54 | If TypeOf a0 Is MalSymbol AndAlso _ |
| 55 | env.find(DirectCast(a0,MalSymbol)) IsNot Nothing Then |
| 56 | Dim mac As MalVal = env.do_get(DirectCast(a0,MalSymbol)) |
| 57 | If TypeOf mac Is MalFunc AndAlso _ |
| 58 | DirectCast(mac,MalFunc).isMacro() Then |
| 59 | return True |
| 60 | End If |
| 61 | End If |
| 62 | End If |
| 63 | return False |
| 64 | End Function |
| 65 | |
| 66 | Shared Function macroexpand(ast As MalVal, env As MalEnv) As MalVal |
| 67 | While is_macro_call(ast, env) |
| 68 | Dim a0 As MalSymbol = DirectCast(DirectCast(ast,MalList)(0),MalSymbol) |
| 69 | Dim mac As MalFunc = DirectCast(env.do_get(a0),MalFunc) |
| 70 | ast = mac.apply(DirectCast(ast,MalList).rest()) |
| 71 | End While |
| 72 | return ast |
| 73 | End Function |
| 74 | |
| 75 | Shared Function eval_ast(ast As MalVal, env As MalEnv) As MalVal |
| 76 | If TypeOf ast Is MalSymbol Then |
| 77 | return env.do_get(DirectCast(ast, MalSymbol)) |
| 78 | Else If TypeOf ast Is MalList Then |
| 79 | Dim old_lst As MalList = DirectCast(ast, MalList) |
| 80 | Dim new_lst As MalList |
| 81 | If ast.list_Q() Then |
| 82 | new_lst = New MalList |
| 83 | Else |
| 84 | new_lst = DirectCast(New MalVector, MalList) |
| 85 | End If |
| 86 | Dim mv As MalVal |
| 87 | For Each mv in old_lst.getValue() |
| 88 | new_lst.conj_BANG(EVAL(mv, env)) |
| 89 | Next |
| 90 | return new_lst |
| 91 | Else If TypeOf ast Is MalHashMap Then |
| 92 | Dim new_dict As New Dictionary(Of String, MalVal) |
| 93 | Dim entry As KeyValuePair(Of String, MalVal) |
| 94 | For Each entry in DirectCast(ast,MalHashMap).getValue() |
| 95 | new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) |
| 96 | Next |
| 97 | return New MalHashMap(new_dict) |
| 98 | Else |
| 99 | return ast |
| 100 | End If |
| 101 | return ast |
| 102 | End Function |
| 103 | |
| 104 | ' TODO: move to types.vb when it is ported |
| 105 | Class FClosure |
| 106 | Public ast As MalVal |
| 107 | Public params As MalList |
| 108 | Public env As MalEnv |
| 109 | Function fn(args as MalList) As MalVal |
| 110 | return EVAL(ast, new MalEnv(env, params, args)) |
| 111 | End Function |
| 112 | End Class |
| 113 | |
| 114 | Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal |
| 115 | Do |
| 116 | |
| 117 | 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) |
| 118 | If not orig_ast.list_Q() Then |
| 119 | return eval_ast(orig_ast, env) |
| 120 | End If |
| 121 | |
| 122 | ' apply list |
| 123 | Dim expanded As MalVal = macroexpand(orig_ast, env) |
| 124 | if not expanded.list_Q() Then |
| 125 | return eval_ast(expanded, env) |
| 126 | End If |
| 127 | Dim ast As MalList = DirectCast(expanded, MalList) |
| 128 | |
| 129 | If ast.size() = 0 Then |
| 130 | return ast |
| 131 | End If |
| 132 | Dim a0 As MalVal = ast(0) |
| 133 | Dim a0sym As String |
| 134 | If TypeOf a0 is MalSymbol Then |
| 135 | a0sym = DirectCast(a0,MalSymbol).getName() |
| 136 | Else |
| 137 | a0sym = "__<*fn*>__" |
| 138 | End If |
| 139 | |
| 140 | Select a0sym |
| 141 | Case "def!" |
| 142 | Dim a1 As MalVal = ast(1) |
| 143 | Dim a2 As MalVal = ast(2) |
| 144 | Dim res As MalVal = EVAL(a2, env) |
| 145 | env.do_set(DirectCast(a1,MalSymbol), res) |
| 146 | return res |
| 147 | Case "let*" |
| 148 | Dim a1 As MalVal = ast(1) |
| 149 | Dim a2 As MalVal = ast(2) |
| 150 | Dim key As MalSymbol |
| 151 | Dim val as MalVal |
| 152 | Dim let_env As new MalEnv(env) |
| 153 | For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2 |
| 154 | key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol) |
| 155 | val = DirectCast(a1,MalList)(i+1) |
| 156 | let_env.do_set(key, EVAL(val, let_env)) |
| 157 | Next |
| 158 | orig_ast = a2 |
| 159 | env = let_env |
| 160 | Case "quote" |
| 161 | return ast(1) |
| 162 | Case "quasiquote" |
| 163 | orig_ast = quasiquote(ast(1)) |
| 164 | Case "defmacro!" |
| 165 | Dim a1 As MalVal = ast(1) |
| 166 | Dim a2 As MalVal = ast(2) |
| 167 | Dim res As MalVal = EVAL(a2, env) |
| 168 | DirectCast(res,MalFunc).setMacro() |
| 169 | env.do_set(DirectCast(a1,MalSymbol), res) |
| 170 | return res |
| 171 | Case "macroexpand" |
| 172 | Dim a1 As MalVal = ast(1) |
| 173 | return macroexpand(a1, env) |
| 174 | Case "try*" |
| 175 | Try |
| 176 | return EVAL(ast(1), env) |
| 177 | Catch e As Exception |
| 178 | If ast.size() > 2 Then |
| 179 | Dim exc As MalVal |
| 180 | Dim a2 As MalVal = ast(2) |
| 181 | Dim a20 As MalVal = DirectCast(a2,MalList)(0) |
| 182 | If DirectCast(a20,MalSymbol).getName() = "catch*" Then |
| 183 | If TypeOf e Is Mal.types.MalException Then |
| 184 | exc = DirectCast(e,Mal.types.MalException).getValue() |
| 185 | Else |
| 186 | exc = New MalString(e.StackTrace) |
| 187 | End If |
| 188 | return EVAL( |
| 189 | DirectCast(a2,MalList)(2), |
| 190 | New MalEnv(env, |
| 191 | DirectCast(a2,MalList).slice(1,2), |
| 192 | New MalList(exc))) |
| 193 | End If |
| 194 | End If |
| 195 | Throw e |
| 196 | End Try |
| 197 | Case "do" |
| 198 | eval_ast(ast.slice(1, ast.size()-1), env) |
| 199 | orig_ast = ast(ast.size()-1) |
| 200 | Case "if" |
| 201 | Dim a1 As MalVal = ast(1) |
| 202 | Dim cond As MalVal = EVAL(a1, env) |
| 203 | If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then |
| 204 | ' eval false slot form |
| 205 | If ast.size() > 3 Then |
| 206 | orig_ast = ast(3) |
| 207 | Else |
| 208 | return Mal.types.Nil |
| 209 | End If |
| 210 | Else |
| 211 | ' eval true slot form |
| 212 | orig_ast = ast(2) |
| 213 | |
| 214 | End If |
| 215 | Case "fn*" |
| 216 | Dim fc As New FClosure() |
| 217 | fc.ast = ast(2) |
| 218 | fc.params = DirectCast(ast(1),MalLIst) |
| 219 | fc.env = env |
| 220 | Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn |
| 221 | Dim mf As new MalFunc(ast(2), env, |
| 222 | DirectCast(ast(1),MalList), f) |
| 223 | return DirectCast(mf,MalVal) |
| 224 | Case Else |
| 225 | Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) |
| 226 | Dim f As MalFunc = DirectCast(el(0), MalFunc) |
| 227 | Dim fnast As MalVal = f.getAst() |
| 228 | If not fnast Is Nothing |
| 229 | orig_ast = fnast |
| 230 | env = f.genEnv(el.rest()) |
| 231 | Else |
| 232 | Return f.apply(el.rest()) |
| 233 | End If |
| 234 | End Select |
| 235 | |
| 236 | Loop While True |
| 237 | End Function |
| 238 | |
| 239 | ' print |
| 240 | Shared Function PRINT(exp As MalVal) As String |
| 241 | return printer._pr_str(exp, TRUE) |
| 242 | End Function |
| 243 | |
| 244 | ' repl |
| 245 | Shared repl_env As MalEnv |
| 246 | |
| 247 | Shared Function REP(str As String) As String |
| 248 | Return PRINT(EVAL(READ(str), repl_env)) |
| 249 | End Function |
| 250 | |
| 251 | Shared Function do_eval(args As MalList) As MalVal |
| 252 | Return EVAL(args(0), repl_env) |
| 253 | End Function |
| 254 | |
| 255 | Shared Function Main As Integer |
| 256 | Dim args As String() = Environment.GetCommandLineArgs() |
| 257 | |
| 258 | repl_env = New MalEnv(Nothing) |
| 259 | |
| 260 | ' core.vb: defined using VB.NET |
| 261 | For Each entry As KeyValuePair(Of String,MalVal) In core.ns() |
| 262 | repl_env.do_set(new MalSymbol(entry.Key), entry.Value) |
| 263 | Next |
| 264 | repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval)) |
| 265 | Dim fileIdx As Integer = 1 |
| 266 | If args.Length > 1 AndAlso args(1) = "--raw" Then |
| 267 | Mal.readline.SetMode(Mal.readline.Modes.Raw) |
| 268 | fileIdx = 2 |
| 269 | End If |
| 270 | Dim argv As New MalList() |
| 271 | For i As Integer = fileIdx+1 To args.Length-1 |
| 272 | argv.conj_BANG(new MalString(args(i))) |
| 273 | Next |
| 274 | repl_env.do_set(new MalSymbol("*ARGV*"), argv) |
| 275 | |
| 276 | ' core.mal: defined using the language itself |
| 277 | REP("(def! *host-language* ""VB.NET"")") |
| 278 | REP("(def! not (fn* (a) (if a false true)))") |
| 279 | REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))") |
| 280 | REP("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons 'cond (rest (rest xs)))))))") |
| 281 | REP("(def! inc (fn* [x] (+ x 1)))") |
| 282 | REP("(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str ""G__"" (swap! counter inc))))))") |
| 283 | REP("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))") |
| 284 | |
| 285 | If args.Length > fileIdx Then |
| 286 | REP("(load-file """ & args(fileIdx) & """)") |
| 287 | return 0 |
| 288 | End If |
| 289 | |
| 290 | ' repl loop |
| 291 | Dim line As String |
| 292 | REP("(println (str ""Mal ["" *host-language* ""]""))") |
| 293 | Do |
| 294 | Try |
| 295 | line = Mal.readline.Readline("user> ") |
| 296 | If line is Nothing Then |
| 297 | Exit Do |
| 298 | End If |
| 299 | If line = "" Then |
| 300 | Continue Do |
| 301 | End If |
| 302 | Catch e As IOException |
| 303 | Console.WriteLine("IOException: " & e.Message) |
| 304 | End Try |
| 305 | Try |
| 306 | Console.WriteLine(REP(line)) |
| 307 | Catch e As Mal.types.MalException |
| 308 | Console.WriteLine("Error: " & _ |
| 309 | printer._pr_str(e.getValue(), False)) |
| 310 | Continue Do |
| 311 | Catch e As Exception |
| 312 | Console.WriteLine("Error: " & e.Message) |
| 313 | Console.WriteLine(e.StackTrace) |
| 314 | Continue Do |
| 315 | End Try |
| 316 | Loop While True |
| 317 | End function |
| 318 | End Class |
| 319 | End Namespace |