kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-09-11 13:55:55 +03:00
Code Issues Projects Releases Wiki Activity

VB.Net: port of C# version.

Browse Source
This commit is contained in:
Joel Martin 2014-11-15 23:15:09 -06:00
parent c3b508af92
commit ee7cd5859e
23 changed files with 4537 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -33,3 +33,5 @@ rust/mal
rust/Cargo.lock
rust/.cargo
r/lib
vb/*.exe
vb/*.dll

5
Makefile
View File

@ -11,7 +11,7 @@ PYTHON = python
#
IMPLS = bash c clojure coffee cs go java js make mal perl php ps \
python r ruby rust
python r ruby rust vb
step0 = step0_repl
step1 = step1_read_print
@ -65,6 +65,7 @@ python_STEP_TO_PROG = python/$($(1)).py
r_STEP_TO_PROG = r/$($(1)).r
ruby_STEP_TO_PROG = ruby/$($(1)).rb
rust_STEP_TO_PROG = rust/target/$($(1))
vb_STEP_TO_PROG = vb/$($(1)).exe
bash_RUNSTEP = bash ../$(2) $(3)
@ -84,10 +85,12 @@ python_RUNSTEP = $(PYTHON) ../$(2) $(3)
r_RUNSTEP = Rscript ../$(2) $(3)
ruby_RUNSTEP = ruby ../$(2) $(3)
rust_RUNSTEP = ../$(2) $(3)
vb_RUNSTEP = mono ../$(2) --raw $(3)
# Extra options to pass to runtest.py
cs_TEST_OPTS = --redirect
mal_TEST_OPTS = --start-timeout 60 --test-timeout 120
vb_TEST_OPTS = --redirect
# Derived lists

19
README.md
View File

@ -3,7 +3,7 @@
## Description
Mal is an interpreter for a subset of the Clojure programming
language. Mal is implemented from scratch in 17 different languages:
language. Mal is implemented from scratch in 18 different languages:
* Bash shell
* C
@ -22,6 +22,7 @@ language. Mal is implemented from scratch in 17 different languages:
* R
* Ruby
* Rust
* Visual Basic.NET
Mal is also a learning tool. Each implementation of mal is separated
@ -78,7 +79,7 @@ required to build and run the C# implementation.
```
cd cs
make
mono ./stepX_YYY
mono ./stepX_YYY.exe
```
@ -213,6 +214,20 @@ cargo build
./target/stepX_YYY
```
### Visual Basic.NET ###
The VB.NET implementation of mal has been tested on Linux using the Mono
VB compiler (vbnc) and the Mono runtime (version 2.10.8.1). Both are
required to build and run the VB.NET implementation.
```
cd vb
make
mono ./stepX_YYY.exe
```
## Running tests
The are nearly 400 generic Mal tests (for all implementations) in the

1
mal/core.mal
View File

@ -4,6 +4,7 @@
["nil?" nil?]
["true?" true?]
["false?" false?]
["symbol" symbol]
["symbol?" symbol?]
["pr-str" pr-str]

52
vb/Makefile Normal file
View File

@ -0,0 +1,52 @@
#####################
DEBUG =
TESTS =
SOURCES_BASE = readline.vb types.vb reader.vb printer.vb
SOURCES_LISP = env.vb core.vb stepA_interop.vb
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
#####################
SRCS = step0_repl.vb step1_read_print.vb step2_eval.vb \
step3_env.vb step4_if_fn_do.vb step5_tco.vb step6_file.vb \
step7_quote.vb step8_macros.vb step9_try.vb stepA_interop.vb
LIB_CS_SRCS = getline.cs
LIB_VB_SRCS = $(filter-out step%,$(filter %.vb,$(SOURCES)))
FLAGS = $(if $(strip $(DEBUG)),-debug:full,)
#####################
all: mal.exe $(patsubst %.vb,%.exe,$(SRCS))
mal.exe: $(patsubst %.vb,%.exe,$(word $(words $(SOURCES)),$(SOURCES)))
cp $< $@
mal_cs.dll: $(LIB_CS_SRCS)
mcs $(FLAGS) -target:library $+ -out:$@
mal_vb.dll: mal_cs.dll $(LIB_VB_SRCS)
vbnc $(FLAGS) -target:library -r:mal_cs.dll $(LIB_VB_SRCS) -out:$@
%.exe: %.vb mal_vb.dll
vbnc $(FLAGS) -r:mal_vb.dll -r:mal_cs.dll $<
clean:
rm -f *.dll *.exe *.mdb
.PHONY: stats tests $(TESTS)
stats: $(SOURCES)
@wc $^
stats-lisp: $(SOURCES_LISP)
@wc $^
tests: $(TESTS)
$(TESTS):
@echo "Running $@"; \
./$@ || exit 1; \

427
vb/core.vb Normal file
View File

@ -0,0 +1,427 @@
Imports System
Imports System.IO
Imports System.Collections.Generic
Imports MalVal = Mal.types.MalVal
Imports MalConstant = Mal.types.MalConstant
Imports MalInt = Mal.types.MalInt
Imports MalSymbol = Mal.types.MalSymbol
Imports MalString = Mal.types.MalString
Imports MalList = Mal.types.MalList
Imports MalVector = Mal.types.MalVector
Imports MalHashMap = Mal.types.MalHashMap
Imports MalAtom = Mal.types.MalAtom
Imports MalFunc = Mal.types.MalFunc
Namespace Mal
Public Class core
Shared Nil As MalConstant = Mal.types.Nil
Shared MalTrue As MalConstant = Mal.types.MalTrue
Shared MalFalse As MalConstant = Mal.types.MalFalse
' Errors/Exceptions
Shared Function mal_throw(a As MalList) As MalVal
throw New Mal.types.MalException(a(0))
End Function
' General functions
Shared Function equal_Q(a As MalList) As MalVal
If Mal.types._equal_Q(a(0), a(1)) Then
return MalTrue
Else
return MalFalse
End If
End Function
' Scalar functions
Shared Function nil_Q(a As MalList) As MalVal
If a(0) Is Nil Then
return MalTrue
Else
return MalFalse
End If
End Function
Shared Function true_Q(a As MalList) As MalVal
If a(0) Is MalTrue Then
return MalTrue
Else
return MalFalse
End If
End Function
Shared Function false_Q(a As MalList) As MalVal
If a(0) Is MalFalse Then
return MalTrue
Else
return MalFalse
End If
End Function
Shared Function symbol(a As MalList) As MalVal
return new MalSymbol(DirectCast(a(0),MalString))
End Function
Shared Function symbol_Q(a As MalList) As MalVal
If TypeOf a(0) Is MalSymbol Then
return MalTrue
Else
return MalFalse
End If
End Function
' Number functions
Shared Function lt(a As MalList) As MalVal
return DirectCast(a(0),MalInt) < DirectCast(a(1),MalInt)
End Function
Shared Function lte(a As MalList) As MalVal
return DirectCast(a(0),MalInt) <= DirectCast(a(1),MalInt)
End Function
Shared Function gt(a As MalList) As MalVal
return DirectCast(a(0),MalInt) > DirectCast(a(1),MalInt)
End Function
Shared Function gte(a As MalList) As MalVal
return DirectCast(a(0),MalInt) >= DirectCast(a(1),MalInt)
End Function
Shared Function plus(a As MalList) As MalVal
return DirectCast(a(0),MalInt) + DirectCast(a(1),MalInt)
End Function
Shared Function minus(a As MalList) As MalVal
return DirectCast(a(0),MalInt) - DirectCast(a(1),MalInt)
End Function
Shared Function mult(a As MalList) As MalVal
return DirectCast(a(0),MalInt) * DirectCast(a(1),MalInt)
End Function
Shared Function div(a As MalList) As MalVal
return DirectCast(a(0),MalInt) / DirectCast(a(1),MalInt)
End Function
Shared Function time_ms(a As MalList) As MalVal
return New MalInt(DateTime.Now.Ticks / TimeSpan.TicksPerMillisecond)
End Function
' String functions
Shared Function pr_str(a As MalList) As MalVal
return New MalString(printer._pr_str_args(a, " ", true))
End Function
Shared Function str(a As MalList) As MalVal
return new MalString(printer._pr_str_args(a, "", false))
End Function
Shared Function prn(a As MalList) As MalVal
Console.WriteLine(printer._pr_str_args(a, " ", true))
return Nil
End Function
Shared Function println(a As MalList) As MalVal
Console.WriteLine(printer._pr_str_args(a, " ", false))
return Nil
End Function
Shared Function mal_readline(a As MalList) As MalVal
Dim line As String
line = readline.Readline(DirectCast(a(0),MalString).getValue())
If line Is Nothing Then
return types.Nil
Else
return New MalString(line)
End If
End Function
Shared Function read_string(a As MalList) As MalVal
return reader.read_str(DirectCast(a(0),MalString).getValue())
End Function
Shared Function slurp(a As MalList) As MalVal
return New MalString(File.ReadAllText(DirectCast(a(0),MalString).getValue()))
End Function
' List/Vector functions
Shared Function list(a As MalList) As MalVal
return New MalList(a.getValue())
End Function
Shared Function list_Q(a As MalList) As MalVal
If TypeOf a(0) Is MalList And Not TypeOf a(0) Is MalVector Then
return MalTrue
Else
return MalFalse
End If
End Function
Shared Function vector(a As MalList) As MalVal
return New MalVector(a.getValue())
End Function
Shared Function vector_Q(a As MalList) As MalVal
If TypeOf a(0) Is MalVector Then
return MalTrue
Else
return MalFalse
End If
End Function
' HashMap functions
Shared Function hash_map(a As MalList) As MalVal
return New MalHashMap(a)
End Function
Shared Function hash_map_Q(a As MalList) As MalVal
If TypeOf a(0) Is MalHashMap Then
return MalTrue
Else
return MalFalse
End If
End Function
Shared Function contains_Q(a As MalList) As MalVal
Dim key As String = DirectCast(a(1),MalString).getValue()
Dim dict As Dictionary(Of String,MalVal) = DirectCast(a(0),MalHashMap).getValue()
If dict.ContainsKey(key) Then
return MalTrue
Else
return MalFalse
End If
End Function
Shared Function assoc(a As MalList) As MalVal
Dim new_hm As MalHashMap = DirectCast(a(0),MalHashMap).copy()
return new_hm.assoc_BANG(DirectCast(a.slice(1),MalList))
End Function
Shared Function dissoc(a As MalList) As MalVal
Dim new_hm As MalHashMap = DirectCast(a(0),MalHashMap).copy()
return new_hm.dissoc_BANG(DirectCast(a.slice(1),MalList))
End Function
Shared Function do_get(a As MalList) As MalVal
Dim k As String = DirectCast(a(1),MalString).getValue()
If a(0) Is Nil Then
return Nil
Else
Dim dict As Dictionary(Of String,MalVal) = DirectCast(a(0),MalHashMap).getValue()
If dict.ContainsKey(k) Then
return dict(k)
Else
return Nil
End If
End If
End Function
Shared Function keys(a As MalList) As MalVal
Dim dict As Dictionary(Of String,MalVal) = DirectCast(a(0),MalHashMap).getValue()
Dim key_lst As MalList = New MalList()
For Each key As String in dict.Keys
key_lst.conj_BANG(new MalString(key))
Next
return key_lst
End Function
Shared Function vals(a As MalList) As MalVal
Dim dict As Dictionary(Of String,MalVal) = DirectCast(a(0),MalHashMap).getValue()
Dim val_lst As MalList = New MalList()
For Each val As MalVal In dict.Values
val_lst.conj_BANG(val)
Next
return val_lst
End Function
' Sequence functions
Shared Function sequential_Q(a As MalList) As MalVal
If TypeOf a(0) Is MalList Then
return MalTrue
Else
return MalFalse
End If
End Function
Shared Function cons(a As MalList) As MalVal
Dim lst As New List(Of MalVal)
lst.Add(a(0))
lst.AddRange(DirectCast(a(1),MalList).getValue())
return DirectCast(New MalList(lst),MalVal)
End Function
Shared Function concat(a As MalList) As MalVal
If a.size() = 0 Then
return new MalList()
End If
Dim lst As New List(Of MalVal)
lst.AddRange(DirectCast(a(0),MalList).getValue())
for i As Integer = 1 To a.size()-1
lst.AddRange(DirectCast(a(i),MalList).getValue())
Next
return DirectCast(new MalList(lst),MalVal)
End Function
Shared Function nth(a As MalList) As MalVal
return DirectCast(a(0),MalList)( DirectCast(a(1),MalInt).getValue() )
End Function
Shared Function first(a As MalList) As MalVal
return DirectCast(a(0),MalList)(0)
End Function
Shared Function rest(a As MalList) As MalVal
return DirectCast(a(0),MalList).rest()
End Function
Shared Function empty_Q(a As MalList) As MalVal
If DirectCast(a(0),MalList).size() = 0 Then
return MalTrue
Else
return MalFalse
End If
End Function
Shared Function count(a As MalList) As MalVal
return new MalInt(DirectCast(a(0),MalList).size())
End Function
Shared Function conj(a As MalList) As MalVal
Dim src_lst As List(Of MalVal) = DirectCast(a(0),MalList).getValue()
Dim new_lst As New List(Of MalVal)
new_lst.AddRange(src_lst)
If TypeOf a(0) Is MalVector Then
For i As Integer = 1 To a.size()-1
new_lst.Add(a(i))
Next
return new MalVector(new_lst)
Else
For i As Integer = 1 To a.size()-1
new_lst.Insert(0, a(i))
Next
return new MalList(new_lst)
End If
End Function
' General list related functions
Shared Function apply(a As MalList) As MalVal
Dim f As MalFunc = DirectCast(a(0),MalFunc)
Dim lst As New List(Of MalVal)
lst.AddRange(a.slice(1,a.size()-1).getValue())
lst.AddRange(DirectCast(a(a.size()-1),MalList).getValue())
return f.apply(New MalList(lst))
End Function
Shared Function map(a As MalList) As MalVal
Dim f As MalFunc = DirectCast(a(0),MalFunc)
Dim src_lst As List(Of MalVal) = DirectCast(a(1),MalList).getValue()
Dim new_lst As New List(Of MalVal)
for i As Integer = 0 To src_lst.Count-1
new_lst.Add(f.apply(New MalList(src_lst(i))))
Next
return new MalList(new_lst)
End Function
' Metadata functions
Shared Function atom(a As MalList) As MalVal
return new MalAtom(a(0))
End Function
Shared Function meta(a As MalList) As MalVal
return a(0).getMeta()
End Function
Shared Function with_meta(a As MalList) As MalVal
return DirectCast(a(0),MalVal).copy().setMeta(a(1))
End Function
' Atom functions
Shared Function atom_Q(a As MalList) As MalVal
If TypeOf a(0) Is MalAtom Then
return MalTrue
Else
return MalFalse
End If
End Function
Shared Function deref(a As MalList) As MalVal
return DirectCast(a(0),MalAtom).getValue()
End Function
Shared Function reset_BANG(a As MalList) As MalVal
return DirectCast(a(0),MalAtom).setValue(a(1))
End Function
Shared Function swap_BANG(a As MalList) As MalVal
Dim atm As MalAtom = DirectCast(a(0),MalAtom)
Dim f As MalFunc = DirectCast(a(1),MalFunc)
Dim new_lst As New List(Of MalVal)
new_lst.Add(atm.getValue())
new_lst.AddRange(DirectCast(a.slice(2),MalList).getValue())
return atm.setValue(f.apply(New MalList(new_lst)))
End Function
Shared Function ns As Dictionary(Of String, MalVal)
Dim ns As New Dictionary(Of String, MalVal)
ns.Add("=", New MalFunc(AddressOf equal_Q))
ns.Add("throw", New MalFunc(AddressOf mal_throw))
ns.Add("nil?", New MalFunc(AddressOf nil_Q))
ns.Add("true?", New MalFunc(AddressOf true_Q))
ns.Add("false?", New MalFunc(AddressOf false_Q))
ns.Add("symbol", new MalFunc(AddressOf symbol))
ns.Add("symbol?", New MalFunc(AddressOf symbol_Q))
ns.Add("pr-str",New MalFunc(AddressOf pr_str))
ns.Add("str", New MalFunc(AddressOf str))
ns.Add("prn", New MalFunc(AddressOf prn))
ns.Add("println", New MalFunc(AddressOf println))
ns.Add("readline", New MalFunc(AddressOf mal_readline))
ns.Add("read-string", New MalFunc(AddressOf read_string))
ns.Add("slurp", New MalFunc(AddressOf slurp))
ns.Add("<", New MalFunc(AddressOf lt))
ns.Add("<=", New MalFunc(AddressOf lte))
ns.Add(">", New MalFunc(AddressOf gt))
ns.Add(">=", New MalFunc(AddressOf gte))
ns.Add("+", New MalFunc(AddressOf plus))
ns.Add("-", New MalFunc(AddressOf minus))
ns.Add("*", New MalFunc(AddressOf mult))
ns.Add("/", New MalFunc(AddressOf div))
ns.Add("time-ms", New MalFunc(AddressOf time_ms))
ns.Add("list", New MalFunc(AddressOf list))
ns.Add("list?", New MalFunc(AddressOf list_Q))
ns.Add("vector", new MalFunc(AddressOf vector))
ns.Add("vector?", New MalFunc(AddressOf vector_Q))
ns.Add("hash-map", new MalFunc(AddressOf hash_map))
ns.Add("map?", New MalFunc(AddressOf hash_map_Q))
ns.Add("contains?", New MalFunc(AddressOf contains_Q))
ns.Add("assoc", New MalFunc(AddressOf assoc))
ns.Add("dissoc", New MalFunc(AddressOf dissoc))
ns.Add("get", New MalFunc(AddressOf do_get))
ns.Add("keys", New MalFunc(AddressOf keys))
ns.Add("vals", New MalFunc(AddressOf vals))
ns.Add("sequential?", New MalFunc(AddressOf sequential_Q))
ns.Add("cons", New MalFunc(AddressOf cons))
ns.Add("concat", New MalFunc(AddressOf concat))
ns.Add("nth", New MalFunc(AddressOf nth))
ns.Add("first", New MalFunc(AddressOf first))
ns.Add("rest", New MalFunc(AddressOf rest))
ns.Add("empty?", New MalFunc(AddressOf empty_Q))
ns.Add("count",New MalFunc(AddressOf count))
ns.Add("conj", New MalFunc(AddressOf conj))
ns.Add("apply", New MalFunc(AddressOf apply))
ns.Add("map", New MalFunc(AddressOf map))
ns.Add("with-meta", New MalFunc(AddressOf with_meta))
ns.Add("meta", New MalFunc(AddressOf meta))
ns.Add("atom", new MalFunc(AddressOf atom))
ns.Add("atom?", New MalFunc(AddressOf atom_Q))
ns.Add("deref", New MalFunc(AddressOf deref))
ns.Add("reset!", New MalFunc(AddressOf reset_BANG))
ns.Add("swap!", New MalFunc(AddressOf swap_BANG))
return ns
End Function
End Class
End Namespace

55
vb/env.vb Normal file
View File

@ -0,0 +1,55 @@
Imports System.Collections.Generic
Imports Mal
Imports MalVal = Mal.types.MalVal
Imports MalSymbol = Mal.types.MalSymbol
Imports MalList = Mal.types.MalList
Namespace Mal
Public Class env
Public Class Env
Dim outer As Env = Nothing
Dim data As Dictionary(Of String, MalVal) = New Dictionary(Of String, MalVal)
Public Sub New(new_outer As Env)
outer = new_outer
End Sub
Public Sub New(new_outer As Env, binds As MalList, exprs As MalList)
outer = new_outer
For i As Integer = 0 To binds.size()-1
Dim sym As String = DirectCast(binds.nth(i),MalSymbol).getName()
If sym = "&" Then
data(DirectCast(binds.nth(i+1),MalSymbol).getName()) = exprs.slice(i)
Exit For
Else
data(sym) = exprs.nth(i)
End If
Next
End Sub
Public Function find(key As String) As Env
If data.ContainsKey(key) Then
return Me
Else If outer IsNot Nothing Then
return outer.find(key)
Else
return Nothing
End If
End Function
Public Function do_get(key As String) As MalVal
Dim e As Env = find(key)
If e Is Nothing Then
throw New Mal.types.MalException(
"'" & key & "' not found")
Else
return e.data(key)
End If
End Function
Public Function do_set(key As String, value As MalVal) As Env
data(key) = value
return Me
End Function
End Class
End Class
End Namespace

1089
vb/getline.cs Normal file
View File

File diff suppressed because it is too large Load Diff

50
vb/printer.vb Normal file
View File

@ -0,0 +1,50 @@
Imports System
Imports System.Collections.Generic
Imports System.Text.RegularExpressions
Imports Mal
Imports MalVal = Mal.types.MalVal
Imports MalList = Mal.types.MalList
Namespace Mal
Public Class printer
Shared Function join(value As List(Of MalVal),
delim As String,
print_readably As Boolean) As String
Dim strs As New List(Of String)
For Each mv As MalVal In value
strs.Add(mv.ToString(print_readably))
Next
return String.Join(delim, strs.ToArray())
End Function
Shared Function join(value As Dictionary(Of String, MalVal),
delim As String,
print_readably As Boolean) As String
Dim strs As New List(Of String)
For Each entry As KeyValuePair(Of String, MalVal) In value
If print_readably Then
strs.Add("""" & entry.Key.ToString() & """")
Else
strs.Add(entry.Key.ToString())
End If
strs.Add(entry.Value.ToString(print_readably))
Next
return String.Join(delim, strs.ToArray())
End Function
Shared Function _pr_str(mv As MalVal,
print_readably As Boolean) As String
return mv.ToString(print_readably)
End Function
Shared Function _pr_str_args(args As MalList,
sep As String,
print_readably As Boolean) As String
return join(args.getValue(), sep, print_readably)
End Function
Shared Function escapeString(str As String) As String
return Regex.Escape(str)
End Function
End Class
End Namespace

181
vb/reader.vb Normal file
View File

@ -0,0 +1,181 @@
Imports System
Imports System.Collections
Imports System.Collections.Generic
Imports System.Text.RegularExpressions
Imports Mal
Imports MalVal = Mal.types.MalVal
Imports MalSymbol = Mal.types.MalSymbol
Imports MalList = Mal.types.MalList
Imports MalVector = Mal.types.MalVector
Imports MalHashMap = Mal.types.MalHashMap
Imports MalThrowable = Mal.types.MalThrowable
Imports MalContinue = Mal.types.MalContinue
Namespace Mal
Public Class reader
Public Class ParseError
Inherits MalThrowable
Public Sub New(msg As String)
MyBase.New(msg)
End Sub
End Class
Public Class Reader
Private tokens As New List(Of String)
Private position As Int32 = 0
Sub New(t As List(Of String))
tokens = t
position = 0
End Sub
Public Function peek() As String
If position >= tokens.Count Then
return Nothing
Else
return tokens(position)
End If
End Function
Public Function get_next() As String
If position >= tokens.Count Then
return Nothing
Else
position += 1
return tokens(position-1)
End If
End Function
End Class
Shared Function tokenize(str As String) As List(Of String)
Dim tokens As New List(Of String)
Dim pattern As String = "[\s ,]*(~@|[\[\]{}()'`~@]|""(?:[\\].|[^\\""])*""|;.*|[^\s \[\]{}()'""`~@,;]*)"
Dim regex As New Regex(pattern)
For Each match As Match In regex.Matches(str)
Dim token As String = match.Groups(1).Value
If Not token Is Nothing _
AndAlso Not token = "" _
AndAlso Not token(0) = ";" Then
'Console.WriteLine("match: ^" & match.Groups[1] & "$")
tokens.Add(token)
End If
Next
return tokens
End Function
Shared Function read_atom(rdr As Reader) As MalVal
Dim token As String = rdr.get_next()
Dim pattern As String = "(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^("".*"")$|(^[^""]*$)"
Dim regex As Regex = New Regex(pattern)
Dim match As Match = regex.Match(token)
'Console.WriteLine("token: ^" + token + "$")
If not match.Success Then
throw New ParseError("unrecognized token '" & token & "'")
End If
If match.Groups(1).Value <> String.Empty Then
return New Mal.types.MalInt(Integer.Parse(match.Groups(1).Value))
Else If match.Groups(3).Value <> String.Empty Then
return Mal.types.Nil
Else If match.Groups(4).Value <> String.Empty Then
return Mal.types.MalTrue
Else If match.Groups(5).Value <> String.Empty Then
return Mal.types.MalFalse
Else If match.Groups(6).Value <> String.Empty Then
Dim str As String = match.Groups(6).Value
return New Mal.types.MalString(
str.Substring(1, str.Length-2) _
.Replace("\""", """") _
.Replace("\n", Environment.NewLine))
Else If match.Groups(7).Value <> String.Empty Then
return New Mal.types.MalSymbol(match.Groups(7).Value)
Else
throw New ParseError("unrecognized '" & match.Groups(0).Value & "'")
End If
End Function
Shared Function read_list(rdr As Reader, lst As MalList,
start As String, last As String) As MalVal
Dim token As String = rdr.get_next()
If token(0) <> start Then
throw New ParseError("expected '" & start & "'")
End If
token = rdr.peek()
While token IsNot Nothing AndAlso token(0) <> last
lst.conj_BANG(read_form(rdr))
token = rdr.peek()
End While
If token Is Nothing Then
throw New ParseError("expected '" & last & "', got EOF")
End If
rdr.get_next()
return lst
End Function
Shared Function read_hash_map(rdr As Reader) As MalVal
Dim lst As MalList = DirectCast(read_list(rdr, new MalList(),
"{", "}"),MalList)
return New MalHashMap(lst)
End Function
Shared Function read_form(rdr As Reader) As MalVal
Dim token As String = rdr.peek()
If token Is Nothing Then
throw New MalContinue()
End If
Dim form As MalVal = Nothing
Select token
Case "'"
rdr.get_next()
return New MalList(New MalSymbol("quote"),
read_form(rdr))
Case "`"
rdr.get_next()
return New MalList(New MalSymbol("quasiquote"),
read_form(rdr))
Case "~"
rdr.get_next()
return New MalList(New MalSymbol("unquote"),
read_form(rdr))
Case "~@"
rdr.get_next()
return new MalList(New MalSymbol("splice-unquote"),
read_form(rdr))
Case "^"
rdr.get_next()
Dim meta As MalVal = read_form(rdr)
return new MalList(New MalSymbol("with-meta"),
read_form(rdr),
meta)
Case "@"
rdr.get_next()
return new MalList(New MalSymbol("deref"),
read_form(rdr))
Case "("
form = read_list(rdr, New MalList(), "(" , ")")
Case ")"
throw New ParseError("unexpected ')'")
Case "["
form = read_list(rdr, New MalVector(), "[" , "]")
Case "]"
throw New ParseError("unexpected ']'")
Case "{"
form = read_hash_map(rdr)
Case "}"
throw New ParseError("unexpected '}'")
Case Else
form = read_atom(rdr)
End Select
return form
End Function
Shared Function read_str(str As string) As MalVal
return read_form(New Reader(tokenize(str)))
End Function
End Class
End Namespace

32
vb/readline.vb Normal file
View File

@ -0,0 +1,32 @@
Imports System
Imports Mono.Terminal ' LineEditor (getline.cs)
Namespace Mal
Public Class readline
Enum Modes
Terminal
Raw
End Enum
Public Shared mode As Modes = Modes.Terminal
Shared lineedit As LineEditor = Nothing
Public Shared Sub SetMode(new_mode As Modes)
mode = new_mode
End Sub
Public Shared Function Readline(prompt As String) As String
If mode = Modes.Terminal Then
If lineedit Is Nothing Then
lineedit = New LineEditor("Mal")
End If
return lineedit.Edit(prompt, "")
Else
Console.Write(prompt)
Console.Out.Flush()
return Console.ReadLine()
End If
End Function
End Class
End Namespace

43
vb/step0_repl.vb Normal file
View File

@ -0,0 +1,43 @@
Imports System
Imports Mal
Namespace Mal
class step0_repl
' read
Shared Function READ(str As String) As String
Return str
End Function
' eval
Shared Function EVAL(ast As String, env As String) As String
Return ast
End Function
' print
Shared Function PRINT(exp As String) As String
Return exp
End Function
' repl
Shared Function REP(str As String, env As String) As String
Return PRINT(EVAL(READ(str), env))
End Function
Shared Function Main As Integer
Dim prompt As String = "user> "
Dim line As String
Do
line = Mal.readline.Readline(prompt)
If line is Nothing Then
Exit Do
End If
If line = "" Then
Continue Do
End If
Console.WriteLine(REP(line, ""))
Loop While True
Return 0
End function
end class
End Namespace

59
vb/step1_read_print.vb Normal file
View File

@ -0,0 +1,59 @@
Imports System
Imports System.IO
Imports Mal
Imports MalVal = Mal.types.MalVal
Namespace Mal
class step1_read_print
' read
Shared Function READ(str As String) As MalVal
Return reader.read_str(str)
End Function
' eval
Shared Function EVAL(ast As MalVal, env As String) As MalVal
Return ast
End Function
' print
Shared Function PRINT(exp As MalVal) As String
return printer._pr_str(exp, TRUE)
End Function
' repl
Shared Function REP(str As String) As String
Return PRINT(EVAL(READ(str), ""))
End Function
Shared Function Main As Integer
Dim args As String() = Environment.GetCommandLineArgs()
If args.Length > 1 AndAlso args(1) = "--raw" Then
Mal.readline.SetMode(Mal.readline.Modes.Raw)
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

134
vb/step2_eval.vb Normal file
View File

@ -0,0 +1,134 @@
Imports System
Imports System.IO
Imports System.Collections.Generic
Imports Mal
Imports MalVal = Mal.types.MalVal
Imports MalInt = Mal.types.MalInt
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
Namespace Mal
class step2_eval
' read
Shared Function READ(str As String) As MalVal
Return reader.read_str(str)
End Function
' eval
Shared Function eval_ast(ast As MalVal, env As Dictionary(Of String, MalVal)) As MalVal
If TypeOf ast Is MalSymbol Then
Dim sym As MalSymbol = DirectCast(ast, MalSymbol)
return env.Item(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
Shared Function EVAL(orig_ast As MalVal, env As Dictionary(Of String, MalVal)) As MalVal
'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 el As MalList = DirectCast(eval_ast(ast, env), MalList)
Dim f As MalFunc = DirectCast(el(0), MalFunc)
Return f.apply(el.rest())
End Function
' print
Shared Function PRINT(exp As MalVal) As String
return printer._pr_str(exp, TRUE)
End Function
' repl
Shared repl_env As Dictionary(Of String, MalVal)
Shared Function REP(str As String) As String
Return PRINT(EVAL(READ(str), repl_env))
End Function
Shared Function add(a As MalList) As MalVal
Return DirectCast(a.Item(0),MalInt) + DirectCast(a.Item(1),MalInt)
End Function
Shared Function minus(a As MalList) As MalVal
Return DirectCast(a.Item(0),MalInt) - DirectCast(a.Item(1),MalInt)
End Function
Shared Function mult(a As MalList) As MalVal
Return DirectCast(a.Item(0),MalInt) * DirectCast(a.Item(1),MalInt)
End Function
Shared Function div(a As MalList) As MalVal
Return DirectCast(a.Item(0),MalInt) / DirectCast(a.Item(1),MalInt)
End Function
Shared Function Main As Integer
Dim args As String() = Environment.GetCommandLineArgs()
repl_env = New Dictionary(Of String, MalVal)
repl_env.Add("+", New MalFunc(AddressOf add))
repl_env.Add("-", New MalFunc(AddressOf minus))
repl_env.Add("*", New MalFunc(AddressOf mult))
repl_env.Add("/", New MalFunc(AddressOf div))
If args.Length > 1 AndAlso args(1) = "--raw" Then
Mal.readline.SetMode(Mal.readline.Modes.Raw)
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

156
vb/step3_env.vb Normal file
View File

@ -0,0 +1,156 @@
Imports System
Imports System.IO
Imports System.Collections.Generic
Imports Mal
Imports MalVal = Mal.types.MalVal
Imports MalInt = Mal.types.MalInt
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 step3_eval
' read
Shared Function READ(str As String) As MalVal
Return reader.read_str(str)
End Function
' eval
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
Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal
'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)
Select DirectCast(a0,MalSymbol).getName()
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
return EVAL(a2, let_env)
Case Else
Dim el As MalList = DirectCast(eval_ast(ast, env), MalList)
Dim f As MalFunc = DirectCast(el(0), MalFunc)
Return f.apply(el.rest())
End Select
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 add(a As MalList) As MalVal
Return DirectCast(a.Item(0),MalInt) + DirectCast(a.Item(1),MalInt)
End Function
Shared Function minus(a As MalList) As MalVal
Return DirectCast(a.Item(0),MalInt) - DirectCast(a.Item(1),MalInt)
End Function
Shared Function mult(a As MalList) As MalVal
Return DirectCast(a.Item(0),MalInt) * DirectCast(a.Item(1),MalInt)
End Function
Shared Function div(a As MalList) As MalVal
Return DirectCast(a.Item(0),MalInt) / DirectCast(a.Item(1),MalInt)
End Function
Shared Function Main As Integer
Dim args As String() = Environment.GetCommandLineArgs()
repl_env = New MalEnv(Nothing)
repl_env.do_set("+", New MalFunc(AddressOf add))
repl_env.do_set("-", New MalFunc(AddressOf minus))
repl_env.do_set("*", New MalFunc(AddressOf mult))
repl_env.do_set("/", New MalFunc(AddressOf div))
If args.Length > 1 AndAlso args(1) = "--raw" Then
Mal.readline.SetMode(Mal.readline.Modes.Raw)
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

189
vb/step4_if_fn_do.vb Normal file
View File

@ -0,0 +1,189 @@
Imports System
Imports System.IO
Imports System.Collections.Generic
Imports Mal
Imports MalVal = Mal.types.MalVal
Imports MalInt = Mal.types.MalInt
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 step4_if_fn_do
' read
Shared Function READ(str As String) As MalVal
Return reader.read_str(str)
End Function
' eval
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
'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).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
return EVAL(a2, let_env)
Case "do"
Dim el As MalList = DirectCast(eval_ast(ast.rest(), env), _
MalLIst)
return el(el.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
Dim a3 As MalVal = ast(3)
return EVAL(a3, env)
Else
return Mal.types.Nil
End If
Else
' eval true slot form
Dim a2 As MalVal = ast(2)
return EVAL(a2, env)
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(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)
Return f.apply(el.rest())
End Select
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 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
' core.mal: defined using the language itself
REP("(def! not (fn* (a) (if a false true)))")
If args.Length > 1 AndAlso args(1) = "--raw" Then
Mal.readline.SetMode(Mal.readline.Modes.Raw)
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

198
vb/step5_tco.vb Normal file
View File

@ -0,0 +1,198 @@
Imports System
Imports System.IO
Imports System.Collections.Generic
Imports Mal
Imports MalVal = Mal.types.MalVal
Imports MalInt = Mal.types.MalInt
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 step5_tco
' read
Shared Function READ(str As String) As MalVal
Return reader.read_str(str)
End Function
' eval
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 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).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 "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 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
' core.mal: defined using the language itself
REP("(def! not (fn* (a) (if a false true)))")
If args.Length > 1 AndAlso args(1) = "--raw" Then
Mal.readline.SetMode(Mal.readline.Modes.Raw)
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

216
vb/step6_file.vb Normal file
View File

@ -0,0 +1,216 @@
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 step6_file
' read
Shared Function READ(str As String) As MalVal
Return reader.read_str(str)
End Function
' eval
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 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).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 "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 argv As New MalList()
For i As Integer = 0 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) "")"")))))")
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
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

249
vb/step7_quote.vb Normal file
View File

@ -0,0 +1,249 @@
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 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 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 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).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 "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 argv As New MalList()
For i As Integer = 0 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) "")"")))))")
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
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

289
vb/step8_macros.vb Normal file
View File

@ -0,0 +1,289 @@
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 argv As New MalList()
For i As Integer = 0 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))))))))")
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
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

318
vb/step9_try.vb Normal file
View File

@ -0,0 +1,318 @@
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 step9_try
' 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 "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(entry.Key, entry.Value)
Next
repl_env.do_set("eval", new MalFunc(AddressOf do_eval))
Dim argv As New MalList()
For i As Integer = 0 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! *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))))))))")
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
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

318
vb/stepA_interop.vb Normal file
View File

@ -0,0 +1,318 @@
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).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 "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(entry.Key, entry.Value)
Next
repl_env.do_set("eval", new MalFunc(AddressOf do_eval))
Dim argv As New MalList()
For i As Integer = 0 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! *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))))))))")
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
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

458
vb/types.vb Normal file
View File

@ -0,0 +1,458 @@
Imports System
Imports System.Collections.Generic
Imports System.Text.RegularExpressions
Imports Mal
namespace Mal
Public Class types
'
' Exceptiosn/Errors
'
Public Class MalThrowable
Inherits Exception
Public Sub New()
MyBase.New()
End Sub
Public Sub New(msg As String)
MyBase.New(msg)
End Sub
End Class
Public Class MalError
Inherits MalThrowable
Public Sub New(msg As String)
MyBase.New(msg)
End Sub
End Class
Public Class MalContinue
Inherits MalThrowable
End Class
' Thrown by throw function
Public Class MalException
Inherits MalThrowable
Private value As MalVal
'string Message
Public Sub New(new_value As MalVal)
value = new_value
End Sub
Public Sub New(new_value As String)
MyBase.New(new_value)
value = New MalString(new_value)
End Sub
Public Function getValue() As MalVal
return value
End Function
End Class
'
' General functions
'
Public Shared Function _equal_Q(a As MalVal, b As MalVal) As Boolean
Dim ota As Type = a.GetType()
Dim otb As Type = b.GetType()
If not (ota = otb Or
(TypeOf a Is MalList and TypeOf b Is MalList)) Then
return False
Else
If TypeOf a Is MalInt Then
return DirectCast(a,MalInt).getValue() =
DirectCast(b,MalInt).getValue()
Else If TypeOf a Is MalSymbol Then
return DirectCast(a,MalSymbol).getName() =
DirectCast(b,MalSymbol).getName()
Else If TypeOf a Is MalString Then
return DirectCast(a,MalString).getValue() =
DirectCast(b,MalString).getValue()
Else If TypeOf a Is MalList Then
If DirectCast(a,MalList).size() <>
DirectCast(b,MalList).size()
return False
End If
for i As Integer = 0 To DirectCast(a,MalList).size()-1
If not _equal_Q(DirectCast(a,MalList)(i),
DirectCast(b,MalList)(i))
return False
End If
Next
return True
Else
return a Is b
End If
End If
End Function
Public MustInherit Class MalVal
Private meta As MalVal = Nil
Public Overridable Function copy() As MalVal
return DirectCast(Me.MemberwiseClone(),MalVal)
End Function
' Default is just to call regular toString()
Public Overridable Function ToString() As String
throw New MalException("ToString called on abstract MalVal")
End Function
Public Overridable Function ToString(print_readably As Boolean) As String
return Me.ToString()
End Function
Public Function getMeta() As MalVal
return meta
End Function
Public Function setMeta(m As MalVal) As MalVal
meta = m
return Me
End Function
Public Overridable Function list_Q() As Boolean
return False
End Function
End Class
Public Class MalConstant
Inherits MalVal
Private value As String
Public Sub New(name As String)
value = name
End Sub
Public Shadows Function copy() As MalConstant
return Me
End Function
Public Overrides Function ToString() As String
return value
End Function
Public Overrides Function ToString(print_readably As Boolean) As String
return value
End Function
End Class
Public Shared Nil As MalConstant = New MalConstant("nil")
Public Shared MalTrue As MalConstant = New MalConstant("true")
Public Shared MalFalse As MalConstant = New MalConstant("false")
Public Class MalInt
Inherits MalVal
Private value As Int64
Public Sub New(v As Int64)
value = v
End Sub
Public Shadows Function copy() As MalInt
return Me
End Function
Public Function getValue() As Int64
return value
End Function
Public Overrides Function ToString() As String
return value.ToString()
End Function
Public Overrides Function ToString(print_readably As Boolean) As String
return value.ToString()
End Function
Public Shared Operator <(a As MalInt, b As Malint) As MalConstant
If a.getValue() < b.getValue() Then
return MalTrue
Else
return MalFalse
End If
End Operator
Public Shared Operator <=(a As MalInt, b As Malint) As MalConstant
If a.getValue() <= b.getValue() Then
return MalTrue
Else
return MalFalse
End If
End Operator
Public Shared Operator >(a As MalInt, b As Malint) As MalConstant
If a.getValue() > b.getValue() Then
return MalTrue
Else
return MalFalse
End If
End Operator
Public Shared Operator >=(a As MalInt, b As Malint) As MalConstant
If a.getValue() >= b.getValue() Then
return MalTrue
Else
return MalFalse
End If
End Operator
Public Shared Operator +(a As MalInt, b As Malint) As MalInt
return new MalInt(a.getValue() + b.getValue())
End Operator
Public Shared Operator -(a As MalInt, b As Malint) As MalInt
return new MalInt(a.getValue() - b.getValue())
End Operator
Public Shared Operator *(a As MalInt, b As Malint) As MalInt
return new MalInt(a.getValue() * b.getValue())
End Operator
Public Shared Operator /(a As MalInt, b As Malint) As MalInt
return new MalInt(a.getValue() / b.getValue())
End Operator
End Class
Public Class MalSymbol
Inherits MalVal
Private value As String
Public Sub New(v As String)
value = v
End Sub
Public Sub New(v As MalString)
value = v.getValue()
End Sub
Public Shadows Function copy() As MalSymbol
return Me
End Function
Public Function getName() As String
return value
End Function
Public Overrides Function ToString() As String
return value
End Function
Public Overrides Function ToString(print_readably As Boolean) As String
return value
End Function
End Class
Public Class MalString
Inherits MalVal
Private value As String
Public Sub New(v As String)
value = v
End Sub
Public Shadows Function copy() As MalString
return Me
End Function
Public Function getValue() As String
return value
End Function
Public Overrides Function ToString() As String
return """" & value & """"
End Function
Public Overrides Function ToString(print_readably As Boolean) As String
If print_readably Then
return """" & _
value.Replace("\", "\\") _
.Replace("""", "\""") _
.Replace(Environment.NewLine, "\n") & _
""""
Else
return value
End If
End Function
End Class
Public Class MalList
Inherits MalVal
Public start As String = "("
Public last As String = ")"
Private value As List(Of MalVal)
Public Sub New()
value = New List(Of MalVal)
End Sub
Public Sub New(val As List(Of MalVal))
value = val
End Sub
Public Sub New(ParamArray mvs() As MalVal)
value = New List(Of MalVal)
conj_BANG(mvs)
End Sub
Public Function getValue() As List(Of MalVal)
return value
End Function
Public Overrides Function list_Q() As Boolean
return True
End Function
Public Overrides Function ToString() As String
return start & printer.join(value, " ", true) & last
End Function
Public Overrides Function ToString(print_readably As Boolean) As String
return start & printer.join(value, " ", print_readably) & last
End Function
Public Function conj_BANG(ParamArray mvs() As MalVal) As MalList
For i As Integer = 0 To mvs.Length-1
value.Add(mvs(i))
Next
return Me
End Function
Public Function size() As Int64
return value.Count
End Function
Public Function nth(ByVal idx As Integer) As MalVal
If value.Count > idx Then
return value(idx)
Else
return Nil
End If
End Function
Default Public ReadOnly Property Item(idx As Integer) As MalVal
Get
If value.Count > idx then
return value(idx)
Else
return Nil
End If
End Get
End Property
Public Function rest() As MalList
If size() > 0 Then
return New MalList(value.GetRange(1, value.Count-1))
Else
return New MalList()
End If
End Function
Public Overridable Function slice(start As Int64) As MalList
return New MalList(value.GetRange(start, value.Count-start))
End Function
Public Overridable Function slice(start As Int64, last As Int64) As MalList
return New MalList(value.GetRange(start, last-start))
End Function
End Class
Public Class MalVector
Inherits MalList
' ' Same implementation except for instantiation methods
Public Sub New()
MyBase.New()
start = "["
last = "]"
End Sub
Public Sub New(val As List(Of MalVal))
MyBase.New(val)
start = "["
last = "]"
End Sub
Public Overrides Function list_Q() As Boolean
return False
End Function
Public Overrides Function slice(start As Int64, last As Int64) As MalList
Dim val As List(Of MalVal) = Me.getValue()
return New MalVector(val.GetRange(start, val.Count-start))
End Function
End Class
Public Class MalHashMap
Inherits MalVal
Private value As Dictionary(Of string, MalVal)
Public Sub New(val As Dictionary(Of String, MalVal))
value = val
End Sub
Public Sub New(lst As MalList)
value = New Dictionary(Of String, MalVal)
assoc_BANG(lst)
End Sub
Public Shadows Function copy() As MalHashMap
Dim new_self As MalHashMap = DirectCast(Me.MemberwiseClone(),MalHashMap)
new_self.value = New Dictionary(Of String, MalVal)(value)
return new_self
End Function
Public Function getValue() As Dictionary(Of String, MalVal)
return value
End Function
Public Overrides Function ToString() As String
return "{" & printer.join(value, " ", true) & "}"
End Function
Public Overrides Function ToString(print_readably As Boolean) As String
return "{" & printer.join(value, " ", print_readably) & "}"
End Function
Public Function assoc_BANG(lst As MalList) As MalHashMap
For i As Integer = 0 To lst.size()-1 Step 2
value(DirectCast(lst(i),MalString).getValue()) = lst(i+1)
Next
return Me
End Function
Public Function dissoc_BANG(lst As MalList) As MalHashMap
for i As Integer = 0 To lst.size()-1
value.Remove(DirectCast(lst.nth(i),MalString).getValue())
Next
return Me
End Function
End Class
Public Class MalAtom
Inherits MalVal
Private value As MalVal
Public Sub New(val As MalVal)
value = val
End Sub
'Public MalAtom copy() { return New MalAtom(value) }
Public Function getValue() As MalVal
return value
End Function
Public Function setValue(val As MalVal) As MalVal
value = val
return value
End Function
Public Overrides Function ToString() As String
return "(atom " & printer._pr_str(value, true) & ")"
End Function
Public Overrides Function ToString(print_readably As Boolean) As String
return "(atom " & printer._pr_str(value, print_readably) & ")"
End Function
End Class
Public Class MalFunc
Inherits MalVal
Private fn As Func(Of MalList, MalVal) = Nothing
Private ast As MalVal = Nothing
Private env As Mal.env.Env = Nothing
Private fparams As MalList
Private macro As Boolean = False
Public Sub New(new_fn As Func(Of MalList, MalVal))
fn = new_fn
End Sub
Public Sub New(new_ast As MalVal, new_env As Mal.env.Env,
new_fparams As MalList, new_fn As Func(Of MalList, MalVal))
fn = new_fn
ast = new_ast
env = new_env
fparams = new_fparams
End Sub
Public Overrides Function ToString() As String
If Not ast Is Nothing Then
return "<fn* " & Mal.printer._pr_str(fparams,true) &
" " & Mal.printer._pr_str(ast, true) & ">"
Else
return "<builtin_function " & fn.ToString() & ">"
End If
End Function
Public Function apply(args As MalList) As MalVal
return fn(args)
End Function
Public Function getAst() As MalVal
return ast
End Function
Public Function getEnv() As Mal.env.Env
return env
End Function
Public Function getFParams() As MalList
return fparams
End Function
Public Function genEnv(args As MalList) As Mal.env.Env
return New Mal.env.Env(env, fparams, args)
End Function
Public Function isMacro() As Boolean
return macro
End Function
Public Sub setMacro()
macro = true
End Sub
End Class
End Class
End Namespace