[jackhill/mal.git] / impls / vb / step7_quote.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 step7_quote
        ' read
        Shared Function READ(str As String) As MalVal
            Return reader.read_str(str)
        End Function

        ' eval
        Shared Function starts_with(ast As Malval, sym As String) As MalVal
            If ast.list_Q() Then
                Const lst As MalList = DirectCast(ast, MalList)
                If 0 < lst.size() Then
                    Const fst As MalSymbol = TryCast(lst(0), MalSymbol)
                    If fst IsNot Nothing AndAlso fst.getName() = sym Then
                        return lst(1)
                    End If
                End If
            End If
            return Nothing
        End Function

        Shared Function quasiquote(ast As MalVal) As MalVal
            If TypeOf ast Is Mal.types.MalSymbol or Typeof ast Is Mal.types.MalHashMap Then
                return New MalList(New MalSymbol("quote"), ast)
            End If
            Const source As MalList = TryCast(ast, MalList)
            If source Is Nothing Then
                return ast
            End If
            Const unquoted As MalVal = starts_with(ast, "unquote")
            If unquoted IsNot Nothing Then
                return unquoted
            End If
            Dim result As MalList = New MalList()
            For i As Integer = source.size()-1 To 0 Step -1
                Const elt As MalVal = source(i)
                Const splice_unquoted As MalVal = starts_with(elt, "splice-unquote")
                If splice_unquoted IsNot Nothing Then
                    result = New MalList(New MalSymbol("concat"), splice_unquoted, result)
                Else
                    result = New MalList(New MalSymbol("cons"), quasiquote(elt), result)
                End If
            Next
            If TypeOf ast Is MalVector Then
                result = New MalList(New MalSymbol("vec"), result)
            End If
            return result
        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 ast As MalList = DirectCast(orig_ast, 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 "quasiquoteexpand"
                return quasiquote(ast(1))
            Case "quasiquote"
                orig_ast = quasiquote(ast(1))
            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! not (fn* (a) (if a false true)))")
            REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))")

            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 step7_quote
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
fbfe6784 NB	23	Shared Function starts_with(ast As Malval, sym As String) As MalVal
	24	If ast.list_Q() Then
	25	Const lst As MalList = DirectCast(ast, MalList)
	26	If 0 < lst.size() Then
	27	Const fst As MalSymbol = TryCast(lst(0), MalSymbol)
	28	If fst IsNot Nothing AndAlso fst.getName() = sym Then
	29	return lst(1)
	30	End If
	31	End If
	32	End If
	33	return Nothing
ee7cd585 JM	34	End Function
	35
	36	Shared Function quasiquote(ast As MalVal) As MalVal
fbfe6784	37	If TypeOf ast Is Mal.types.MalSymbol or Typeof ast Is Mal.types.MalHashMap Then
ee7cd585	38	return New MalList(New MalSymbol("quote"), ast)
fbfe6784 NB	39	End If
	40	Const source As MalList = TryCast(ast, MalList)
	41	If source Is Nothing Then
	42	return ast
	43	End If
	44	Const unquoted As MalVal = starts_with(ast, "unquote")
	45	If unquoted IsNot Nothing Then
	46	return unquoted
	47	End If
	48	Dim result As MalList = New MalList()
	49	For i As Integer = source.size()-1 To 0 Step -1
	50	Const elt As MalVal = source(i)
	51	Const splice_unquoted As MalVal = starts_with(elt, "splice-unquote")
	52	If splice_unquoted IsNot Nothing Then
	53	result = New MalList(New MalSymbol("concat"), splice_unquoted, result)
	54	Else
	55	result = New MalList(New MalSymbol("cons"), quasiquote(elt), result)
ee7cd585	56	End If
fbfe6784 NB	57	Next
	58	If TypeOf ast Is MalVector Then
	59	result = New MalList(New MalSymbol("vec"), result)
ee7cd585	60	End If
fbfe6784	61	return result
ee7cd585 JM	62	End Function
	63
	64
	65	Shared Function eval_ast(ast As MalVal, env As MalEnv) As MalVal
	66	If TypeOf ast Is MalSymbol Then
b8ee29b2	67	return env.do_get(DirectCast(ast, MalSymbol))
ee7cd585 JM	68	Else If TypeOf ast Is MalList Then
	69	Dim old_lst As MalList = DirectCast(ast, MalList)
	70	Dim new_lst As MalList
	71	If ast.list_Q() Then
	72	new_lst = New MalList
	73	Else
	74	new_lst = DirectCast(New MalVector, MalList)
	75	End If
	76	Dim mv As MalVal
	77	For Each mv in old_lst.getValue()
	78	new_lst.conj_BANG(EVAL(mv, env))
	79	Next
	80	return new_lst
	81	Else If TypeOf ast Is MalHashMap Then
	82	Dim new_dict As New Dictionary(Of String, MalVal)
	83	Dim entry As KeyValuePair(Of String, MalVal)
	84	For Each entry in DirectCast(ast,MalHashMap).getValue()
	85	new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env))
	86	Next
	87	return New MalHashMap(new_dict)
	88	Else
	89	return ast
	90	End If
	91	return ast
	92	End Function
	93
	94	' TODO: move to types.vb when it is ported
	95	Class FClosure
	96	Public ast As MalVal
	97	Public params As MalList
	98	Public env As MalEnv
	99	Function fn(args as MalList) As MalVal
	100	return EVAL(ast, new MalEnv(env, params, args))
	101	End Function
	102	End Class
	103
	104	Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal
	105	Do
	106
	107	'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true))
	108	If not orig_ast.list_Q() Then
	109	return eval_ast(orig_ast, env)
	110	End If
	111
	112	' apply list
	113	Dim ast As MalList = DirectCast(orig_ast, MalList)
	114	If ast.size() = 0 Then
	115	return ast
	116	End If
	117	Dim a0 As MalVal = ast(0)
	118	Dim a0sym As String
	119	If TypeOf a0 is MalSymbol Then
	120	a0sym = DirectCast(a0,MalSymbol).getName()
	121	Else
	122	a0sym = "__<fn>__"
	123	End If
	124
	125	Select a0sym
	126	Case "def!"
	127	Dim a1 As MalVal = ast(1)
	128	Dim a2 As MalVal = ast(2)
	129	Dim res As MalVal = EVAL(a2, env)
b8ee29b2	130	env.do_set(DirectCast(a1,MalSymbol), res)
ee7cd585 JM	131	return res
	132	Case "let*"
	133	Dim a1 As MalVal = ast(1)
	134	Dim a2 As MalVal = ast(2)
	135	Dim key As MalSymbol
	136	Dim val as MalVal
	137	Dim let_env As new MalEnv(env)
	138	For i As Integer = 0 To (DirectCast(a1,MalList)).size()-1 Step 2
	139	key = DirectCast(DirectCast(a1,MalList)(i),MalSymbol)
	140	val = DirectCast(a1,MalList)(i+1)
b8ee29b2	141	let_env.do_set(key, EVAL(val, let_env))
ee7cd585 JM	142	Next
	143	orig_ast = a2
	144	env = let_env
	145	Case "quote"
	146	return ast(1)
fbfe6784 NB	147	Case "quasiquoteexpand"
fbfe6784 NB	148	return quasiquote(ast(1))
ee7cd585 JM	149	Case "quasiquote"
	150	orig_ast = quasiquote(ast(1))
	151	Case "do"
	152	eval_ast(ast.slice(1, ast.size()-1), env)
	153	orig_ast = ast(ast.size()-1)
	154	Case "if"
	155	Dim a1 As MalVal = ast(1)
	156	Dim cond As MalVal = EVAL(a1, env)
	157	If cond Is Mal.types.Nil or cond Is Mal.types.MalFalse Then
	158	' eval false slot form
	159	If ast.size() > 3 Then
	160	orig_ast = ast(3)
	161	Else
	162	return Mal.types.Nil
	163	End If
	164	Else
	165	' eval true slot form
	166	orig_ast = ast(2)
	167
	168	End If
	169	Case "fn*"
	170	Dim fc As New FClosure()
	171	fc.ast = ast(2)
	172	fc.params = DirectCast(ast(1),MalLIst)
	173	fc.env = env
	174	Dim f As Func(Of MalList, MalVal) = AddressOf fc.fn
	175	Dim mf As new MalFunc(ast(2), env,
	176	DirectCast(ast(1),MalList), f)
	177	return DirectCast(mf,MalVal)
	178	Case Else
	179	Dim el As MalList = DirectCast(eval_ast(ast, env), MalList)
	180	Dim f As MalFunc = DirectCast(el(0), MalFunc)
	181	Dim fnast As MalVal = f.getAst()
	182	If not fnast Is Nothing
	183	orig_ast = fnast
	184	env = f.genEnv(el.rest())
	185	Else
	186	Return f.apply(el.rest())
	187	End If
	188	End Select
	189
	190	Loop While True
	191	End Function
	192
	193	' print
	194	Shared Function PRINT(exp As MalVal) As String
	195	return printer._pr_str(exp, TRUE)
	196	End Function
	197
	198	' repl
	199	Shared repl_env As MalEnv
	200
	201	Shared Function REP(str As String) As String
	202	Return PRINT(EVAL(READ(str), repl_env))
	203	End Function
	204
	205	Shared Function do_eval(args As MalList) As MalVal
	206	Return EVAL(args(0), repl_env)
	207	End Function
	208
	209	Shared Function Main As Integer
	210	Dim args As String() = Environment.GetCommandLineArgs()
	211
	212	repl_env = New MalEnv(Nothing)
213
214	' core.vb: defined using VB.NET
215	For Each entry As KeyValuePair(Of String,MalVal) In core.ns()
b8ee29b2	216	repl_env.do_set(new MalSymbol(entry.Key), entry.Value)
ee7cd585	217	Next
b8ee29b2	218	repl_env.do_set(new MalSymbol("eval"), new MalFunc(AddressOf do_eval))
aaba2493 JM	219	Dim fileIdx As Integer = 1
	220	If args.Length > 1 AndAlso args(1) = "--raw" Then
	221	Mal.readline.SetMode(Mal.readline.Modes.Raw)
	222	fileIdx = 2
	223	End If
ee7cd585	224	Dim argv As New MalList()
aaba2493	225	For i As Integer = fileIdx+1 To args.Length-1
ee7cd585 JM	226	argv.conj_BANG(new MalString(args(i)))
ee7cd585 JM	227	Next
b8ee29b2	228	repl_env.do_set(new MalSymbol("ARGV"), argv)
ee7cd585 JM	229
	230	' core.mal: defined using the language itself
	231	REP("(def! not (fn* (a) (if a false true)))")
e6d41de4	232	REP("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))")
ee7cd585	233
ee7cd585 JM	234	If args.Length > fileIdx Then
	235	REP("(load-file """ & args(fileIdx) & """)")
	236	return 0
	237	End If
	238
	239	' repl loop
	240	Dim line As String
	241	Do
	242	Try
	243	line = Mal.readline.Readline("user> ")
	244	If line is Nothing Then
	245	Exit Do
	246	End If
	247	If line = "" Then
	248	Continue Do
	249	End If
	250	Catch e As IOException
	251	Console.WriteLine("IOException: " & e.Message)
	252	End Try
	253	Try
	254	Console.WriteLine(REP(line))
	255	Catch e as Exception
	256	Console.WriteLine("Error: " & e.Message)
	257	Console.WriteLine(e.StackTrace)
	258	Continue Do
	259	End Try
	260	Loop While True
	261	End function
aaba2493	262	End Class
ee7cd585	263	End Namespace