impls/vb/step8_macros.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 step8_macros
  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 "do"
 175                 eval_ast(ast.slice(1, ast.size()-1), env)
 176                 orig_ast = ast(ast.size()-1)
 177             Case "if"
 178                 Dim a1 As MalVal = ast(1)
 179                 Dim cond As MalVal = EVAL(a1, env)
 180                 If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then
 181                     ' eval false slot form
 182                     If ast.size() > 3 Then
 183                         orig_ast = ast(3)
 184                     Else
 185                         return Mal.types.Nil
 186                     End If
 187                 Else
 188                     ' eval true slot form
 189                     orig_ast = ast(2)
 190
 191                 End If
 192             Case "fn*"
 193                 Dim fc As New FClosure()
 194                 fc.ast = ast(2)
 195                 fc.params = DirectCast(ast(1),MalLIst)
 196                 fc.env = env
 197                 Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn
 198                 Dim mf As new MalFunc(ast(2), env,
 199                                       DirectCast(ast(1),MalList), f)
 200                 return DirectCast(mf,MalVal)
 201             Case Else
 202                 Dim el As MalList = DirectCast(eval_ast(ast, env), MalList)
 203                 Dim f As MalFunc = DirectCast(el(0), MalFunc)
 204                 Dim fnast As MalVal = f.getAst()
 205                 If not fnast Is Nothing
 206                     orig_ast = fnast
 207                     env = f.genEnv(el.rest())
 208                 Else
 209                     Return f.apply(el.rest())
 210                 End If
 211             End Select
 212
 213             Loop While True
 214         End Function
 215
 216         ' print
 217         Shared Function PRINT(exp As MalVal) As String
 218             return printer._pr_str(exp, TRUE)
 219         End Function
 220
 221         ' repl
 222         Shared repl_env As MalEnv
 223
 224         Shared Function REP(str As String) As String
 225             Return PRINT(EVAL(READ(str), repl_env))
 226         End Function
 227
 228         Shared Function do_eval(args As MalList) As MalVal
 229             Return EVAL(args(0), repl_env)
 230         End Function
 231
 232         Shared Function Main As Integer
 233             Dim args As String() = Environment.GetCommandLineArgs()
 234
 235             repl_env = New MalEnv(Nothing)
 236
 237             ' core.vb: defined using VB.NET
 238             For Each entry As KeyValuePair(Of String,MalVal) In core.ns()
 239                 repl_env.do_set(new MalSymbol(entry.Key), entry.Value)
 240             Next
 241             repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval))
 242             Dim fileIdx As Integer = 1
 243             If args.Length > 1 AndAlso args(1) = "--raw" Then
 244                 Mal.readline.SetMode(Mal.readline.Modes.Raw)
 245                 fileIdx = 2
 246             End If
 247             Dim argv As New MalList()
 248             For i As Integer = fileIdx+1 To args.Length-1
 249                 argv.conj_BANG(new MalString(args(i)))
 250             Next
 251             repl_env.do_set(new MalSymbol("*ARGV*"), argv)
 252
 253             ' core.mal: defined using the language itself
 254             REP("(def! not (fn* (a) (if a false true)))")
 255             REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))")
 256             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)))))))")
 257
 258             If args.Length > fileIdx Then
 259                 REP("(load-file """ & args(fileIdx) & """)")
 260                 return 0
 261             End If
 262
 263             ' repl loop
 264             Dim line As String
 265             Do
 266                 Try
 267                     line = Mal.readline.Readline("user> ")
 268                     If line is Nothing Then
 269                         Exit Do
 270                     End If
 271                     If line = "" Then
 272                         Continue Do
 273                     End If
 274                 Catch e As IOException
 275                     Console.WriteLine("IOException: " & e.Message)
 276                 End Try
 277                 Try
 278                     Console.WriteLine(REP(line))
 279                 Catch e as Exception
 280                     Console.WriteLine("Error: " & e.Message)
 281                     Console.WriteLine(e.StackTrace)
 282                     Continue Do
 283                 End Try
 284             Loop While True
 285         End function
 286     End Class
 287 End Namespace