[jackhill/mal.git] / vb / step8_macros.vb

Imports System
Imports System.IO
Imports System.Collections.Generic
Imports Mal
Imports MalVal = Mal.types.MalVal
Imports MalInt = Mal.types.MalInt
Imports MalString = Mal.types.MalString
Imports MalSymbol = Mal.types.MalSymbol
Imports MalList = Mal.types.MalList
Imports MalVector = Mal.types.MalVector
Imports MalHashMap = Mal.types.MalHashMap
Imports MalFunc = Mal.types.MalFunc
Imports MalEnv = Mal.env.Env

Namespace Mal
    Class step8_macros
        ' read
        Shared Function READ(str As String) As MalVal
            Return reader.read_str(str)
        End Function

        ' eval
        Shared Function is_pair(x As MalVal) As Boolean
            return TypeOf x Is MalList AndAlso _
                   DirectCast(x,MalList).size() > 0
        End Function

        Shared Function quasiquote(ast As MalVal) As MalVal
            If not is_pair(ast) Then
                return New MalList(New MalSymbol("quote"), ast)
            Else
                Dim a0 As MalVal = DirectCast(ast,MalList)(0)
                If TypeOf a0 Is MalSymbol AndAlso _
                    DirectCast(a0,MalSymbol).getName() = "unquote" Then
                    return DirectCast(ast,MalList)(1)
                Else If is_pair(a0) Then
                    Dim a00 As MalVal = DirectCast(a0,MalList)(0)
                    If TypeOf a00 is MalSymbol AndAlso _
                        DirectCast(a00,MalSymbol).getName() = "splice-unquote" Then
                        return New MalList(New MalSymbol("concat"),
                                           DirectCast(a0,MalList)(1),
                                           quasiquote(DirectCast(ast,MalList).rest()))
                    End If
                End If
                return New MalList(New MalSymbol("cons"),
                                   quasiquote(a0),
                                   quasiquote(DirectCast(ast,MalList).rest()))
            End If
        End Function

        Shared Function is_macro_call(ast As MalVal, env As MalEnv) As Boolean
            If TypeOf ast Is MalList Then
                Dim a0 As MalVal = DirectCast(ast,MalList)(0)
                If TypeOf a0 Is MalSymbol AndAlso _
                    env.find(DirectCast(a0,MalSymbol).getName()) IsNot Nothing Then
                    Dim mac As MalVal = env.do_get(DirectCast(a0,MalSymbol).getName())
                    If TypeOf mac Is MalFunc AndAlso _
                        DirectCast(mac,MalFunc).isMacro() Then
                        return True
                    End If
                End If
            End If
            return False
        End Function

        Shared Function macroexpand(ast As MalVal, env As MalEnv) As MalVal
            While is_macro_call(ast, env)
                Dim a0 As MalSymbol = DirectCast(DirectCast(ast,MalList)(0),MalSymbol)
                Dim mac As MalFunc = DirectCast(env.do_get(a0.getName()),MalFunc)
                ast = mac.apply(DirectCast(ast,MalList).rest())
            End While
            return ast
        End Function

        Shared Function eval_ast(ast As MalVal, env As MalEnv) As MalVal
            If TypeOf ast Is MalSymbol Then
                Dim sym As MalSymbol = DirectCast(ast, MalSymbol)
                return env.do_get(sym.getName())
            Else If TypeOf ast Is MalList Then
                Dim old_lst As MalList = DirectCast(ast, MalList)
                Dim new_lst As MalList
                If ast.list_Q() Then
                    new_lst = New MalList
                Else
                    new_lst = DirectCast(New MalVector, MalList)
                End If
                Dim mv As MalVal
                For Each mv in old_lst.getValue()
                    new_lst.conj_BANG(EVAL(mv, env))
                Next
                return new_lst
            Else If TypeOf ast Is MalHashMap Then
                Dim new_dict As New Dictionary(Of String, MalVal)
                Dim entry As KeyValuePair(Of String, MalVal)
                For Each entry in DirectCast(ast,MalHashMap).getValue()
                    new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env))
                Next
                return New MalHashMap(new_dict)
            Else
                return ast
            End If
            return ast
        End Function

        ' TODO: move to types.vb when it is ported
        Class FClosure
            Public ast As MalVal
            Public params As MalList
            Public env As MalEnv
            Function fn(args as MalList) As MalVal
                return EVAL(ast, new MalEnv(env, params, args))
            End Function
        End Class

        Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal
            Do

            'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true))
            If not orig_ast.list_Q() Then
                return eval_ast(orig_ast, env)
            End If

            ' apply list
            Dim expanded As MalVal = macroexpand(orig_ast, env)
            if not expanded.list_Q() Then
                return expanded
            End If
            Dim ast As MalList = DirectCast(expanded, MalList)

            If ast.size() = 0  Then
                return ast
            End If
            Dim a0 As MalVal = ast(0)
            Dim a0sym As String
            If TypeOf a0 is MalSymbol Then
                a0sym = DirectCast(a0,MalSymbol).getName()
            Else
                a0sym = "__<*fn*>__"
            End If

            Select a0sym
            Case "def!"
                Dim a1 As MalVal = ast(1)
                Dim a2 As MalVal = ast(2)
                Dim res As MalVal = EVAL(a2, env)
                env.do_set(DirectCast(a1,MalSymbol).getName(), res)
                return res
            Case "let*"
                Dim a1 As MalVal = ast(1)
                Dim a2 As MalVal = ast(2)
                Dim key As MalSymbol
                Dim val as MalVal
                Dim let_env As new MalEnv(env)
                For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2
                    key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol)
                    val = DirectCast(a1,MalList)(i+1)
                    let_env.do_set(key.getName(), EVAL(val, let_env))
                Next
                orig_ast = a2
                env = let_env
            Case "quote"
                return ast(1)
            Case "quasiquote"
                orig_ast = quasiquote(ast(1))
            Case "defmacro!"
                Dim a1 As MalVal = ast(1)
                Dim a2 As MalVal = ast(2)
                Dim res As MalVal = EVAL(a2, env)
                DirectCast(res,MalFunc).setMacro()
                env.do_set(DirectCast(a1,MalSymbol).getName(), res)
                return res
            Case "macroexpand"
                Dim a1 As MalVal = ast(1)
                return macroexpand(a1, env)
            Case "do"
                eval_ast(ast.slice(1, ast.size()-1), env)
                orig_ast = ast(ast.size()-1)
            Case "if"
                Dim a1 As MalVal = ast(1)
                Dim cond As MalVal = EVAL(a1, env)
                If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then
                    ' eval false slot form
                    If ast.size() > 3 Then
                        orig_ast = ast(3)
                    Else
                        return Mal.types.Nil
                    End If
                Else
                    ' eval true slot form
                    orig_ast = ast(2)

                End If
            Case "fn*"
                Dim fc As New FClosure()
                fc.ast = ast(2)
                fc.params = DirectCast(ast(1),MalLIst)
                fc.env = env
                Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn
                Dim mf As new MalFunc(ast(2), env,
                                      DirectCast(ast(1),MalList), f)
                return DirectCast(mf,MalVal)
            Case Else
                Dim el As MalList = DirectCast(eval_ast(ast, env), MalList)
                Dim f As MalFunc = DirectCast(el(0), MalFunc)
                Dim fnast As MalVal = f.getAst()
                If not fnast Is Nothing
                    orig_ast = fnast
                    env = f.genEnv(el.rest())
                Else
                    Return f.apply(el.rest())
                End If
            End Select

            Loop While True
        End Function
        
        ' print
        Shared Function PRINT(exp As MalVal) As String
            return printer._pr_str(exp, TRUE)
        End Function

        ' repl
        Shared repl_env As MalEnv

        Shared Function REP(str As String) As String
            Return PRINT(EVAL(READ(str), repl_env))
        End Function

        Shared Function do_eval(args As MalList) As MalVal
            Return EVAL(args(0), repl_env)
        End Function

        Shared Function Main As Integer
            Dim args As String() = Environment.GetCommandLineArgs()

            repl_env = New MalEnv(Nothing)

            ' core.vb: defined using VB.NET
            For Each entry As KeyValuePair(Of String,MalVal) In core.ns()
                repl_env.do_set(entry.Key, entry.Value)
            Next
            repl_env.do_set("eval", new MalFunc(AddressOf do_eval))
            Dim fileIdx As Integer = 1
            If args.Length > 1 AndAlso args(1) = "--raw" Then
                Mal.readline.SetMode(Mal.readline.Modes.Raw)
                fileIdx = 2
            End If
            Dim argv As New MalList()
            For i As Integer = fileIdx+1 To args.Length-1
                argv.conj_BANG(new MalString(args(i)))
            Next
            repl_env.do_set("*ARGV*", argv)

            ' core.mal: defined using the language itself
            REP("(def! not (fn* (a) (if a false true)))")
            REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))")
            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)))))))")
            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))))))))")

            If args.Length > fileIdx Then
                REP("(load-file """ & args(fileIdx) & """)")
                return 0
            End If

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