[jackhill/mal.git] / vb / stepA_interop.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 stepA_interop
        ' 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)) IsNot Nothing Then
                    Dim mac As MalVal = env.do_get(DirectCast(a0,MalSymbol))
                    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),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
                return env.do_get(DirectCast(ast, MalSymbol))
            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), 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, 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), res)
                return res
            Case "macroexpand"
                Dim a1 As MalVal = ast(1)
                return macroexpand(a1, env)
            Case "try*"
                Try
                    return EVAL(ast(1), env)
                Catch e As Exception
                    If ast.size() > 2 Then
                        Dim exc As MalVal
                        Dim a2 As MalVal = ast(2)
                        Dim a20 As MalVal = DirectCast(a2,MalList)(0)
                        If DirectCast(a20,MalSymbol).getName() = "catch*" Then
                            If TypeOf e Is Mal.types.MalException Then
                                exc = DirectCast(e,Mal.types.MalException).getValue()
                            Else
                                exc = New MalString(e.StackTrace)
                            End If
                            return EVAL(
                                DirectCast(a2,MalList)(2),
                                New MalEnv(env,
                                           DirectCast(a2,MalList).slice(1,2),
                                           New MalList(exc)))
                        End If
                        Throw e
                    End If
                End Try
            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(new MalSymbol(entry.Key), entry.Value)
            Next
            repl_env.do_set(new MalSymbol("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(new MalSymbol("*ARGV*"), argv)

            ' core.mal: defined using the language itself
            REP("(def! *host-language* ""VB.NET"")")
            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
            REP("(println (str ""Mal ["" *host-language* ""]""))")
            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 Mal.types.MalException
                    Console.WriteLine("Error: " & _
                        printer._pr_str(e.getValue(), False))
                    Continue Do
                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
	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 _
b8ee29b2 JM	55	env.find(DirectCast(a0,MalSymbol)) IsNot Nothing Then
b8ee29b2 JM	56	Dim mac As MalVal = env.do_get(DirectCast(a0,MalSymbol))
ee7cd585 JM	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)
b8ee29b2	69	Dim mac As MalFunc = DirectCast(env.do_get(a0),MalFunc)
ee7cd585 JM	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
b8ee29b2	77	return env.do_get(DirectCast(ast, MalSymbol))
ee7cd585 JM	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 expanded
	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)
b8ee29b2	145	env.do_set(DirectCast(a1,MalSymbol), res)
ee7cd585 JM	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)
b8ee29b2	156	let_env.do_set(key, EVAL(val, let_env))
ee7cd585 JM	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()
b8ee29b2	169	env.do_set(DirectCast(a1,MalSymbol), res)
ee7cd585 JM	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	Throw e
	195	End If
	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()
b8ee29b2	262	repl_env.do_set(new MalSymbol(entry.Key), entry.Value)
ee7cd585	263	Next
b8ee29b2	264	repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval))
aaba2493 JM	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
ee7cd585	270	Dim argv As New MalList()
aaba2493	271	For i As Integer = fileIdx+1 To args.Length-1
ee7cd585 JM	272	argv.conj_BANG(new MalString(args(i)))
ee7cd585 JM	273	Next
b8ee29b2	274	repl_env.do_set(new MalSymbol("ARGV"), argv)
ee7cd585 JM	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("(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))))))))")
	282
ee7cd585 JM	283	If args.Length > fileIdx Then
	284	REP("(load-file """ & args(fileIdx) & """)")
	285	return 0
	286	End If
	287
	288	' repl loop
	289	Dim line As String
	290	REP("(println (str ""Mal ["" host-language ""]""))")
	291	Do
	292	Try
	293	line = Mal.readline.Readline("user> ")
	294	If line is Nothing Then
	295	Exit Do
	296	End If
	297	If line = "" Then
	298	Continue Do
	299	End If
	300	Catch e As IOException
	301	Console.WriteLine("IOException: " & e.Message)
	302	End Try
	303	Try
	304	Console.WriteLine(REP(line))
	305	Catch e As Mal.types.MalException
	306	Console.WriteLine("Error: " & _
	307	printer._pr_str(e.getValue(), False))
	308	Continue Do
	309	Catch e As Exception
	310	Console.WriteLine("Error: " & e.Message)
	311	Console.WriteLine(e.StackTrace)
	312	Continue Do
	313	End Try
	314	Loop While True
	315	End function
	316	End Class
	317	End Namespace