vb/stepA_interop.vb

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