[原创] 由纯 VBScript 编写的 Lisp 语言解释器 - MAL.VBS

• 一个学习、练习编写解释器，加深对语言特性理解的开源学习项目。
• 目标是让每一个学习者从头编写一个支持函数作为一等公民、闭包、尾递归优化、垃圾收集、宏、错误处理、元数据的类 Clojure 的 Lisp 方言解释器。
• 解释器需要内置整数、列表、向量、哈希表、字符串、可变原⼦、符号、函数等数据类型。

• 完成了首个使用 VBScript 语言的解释器实现。
• VBScript 实现中已 Self-Hosting、且通过全部测试，手写代码约五千行。
• 正在尝试实现首个使用批处理语言的实现。

• 整体思路：使用 VBScript 已有的类模拟闭包。
• 数据结构：使用一个类似并查集的孩子指向父亲结点的多叉树来表示语言中的环境帧。
• 算法思路：查找变量绑定时首先在当前帧中查找，若无法找到则继续向父级帧中递归查找。

• 需求来源：MAL 语言中使用递归实现迭代（无传统语言中的循环结构），不进行优化就会造成空间浪费甚至栈溢出。
• 尾递归：对函数自身的调用是函数执行的最后一步，之后会返回到上一层栈帧。
• 优化目标：确保尾递归场景出现时调用栈不累加。
• 优化思路：使用惰性求值方式，切换函数调用和返回结果的顺序，先移除当前栈帧再进行下次迭代。

• 需求来源：封装接口就可以用一套逻辑进行统一处理，不必为每个数据类型编写独立的、单独的逻辑。增强了代码的健壮性。
• 遇到障碍：VBScript 语言对面向对象的支持非常有限，没有接口、继承、多态特性。
• 解决思路：VBScript 是动态类型语言，只要在各种数据类型的类中定义相同的属性和方法，就可以模拟接口、继承和多态。

• 需求来源：批处理只支持单行千字以内的字符串，处理特殊字符困难。
• 解决思路（特殊字符）：定义一套符号替换逻辑，预先将符号替换为其它字符串，执行完成后再替换回符号本身。
• 解决思路（单行限制）：通过抽象一套字符串数组实现模拟多行字符串支持，数组的每一个元素代表实际的一行字符。
• 一些思考：替换操作导致了额外的性能开销，是否有更好的方式？

• 需求来源：批处理中没有函数概念，只有标号、跳转和简单的过程调用。
• 解决思路：构造一个全局栈，模拟函数栈帧。使用全局栈完成参数传递、备份、返回值传递的需求。
• 一些思考：是否可以不借助函数这层抽象就完成项目实现？

• 由于 VBScript 默认为按地址传递参数，导致修改函数实参时影响到调用者传入变量的值。
• 在异常捕获语句块中再次抛出异常，逻辑上处理有误导致项目奔溃。

• 代码简洁和运行效率之间如何取舍？
• 引入函数作为一等公民、闭包对语言复杂性、性能有何影响？
• 舍弃循环，统一使用递归实现迭代，真的合理吗？
• 在有复杂逻辑的项目中如何进行高效的 Debug？

• 项目仓库：https://github.com/kanaka/mal
• 本人分支：https://github.com/OldLiu001/mal

' mal.vbs
' A MAL (Lisp) Language Interpreter witten in VBScript
' Code by OldLiu (632171029@qq.com)
' https://github.com/kanaka/mal
' https://github.com/OldLiu001/mal/tree/master/impls/vbs
 
Option Explicit
 
CreateObject("System.Collections.ArrayList")
 
Const strHost = "CSCRIPT.EXE" 'WSCRIPT
If Not UCase(Right(WScript.FullName,11)) = UCase(strHost) Then
        Dim Args,Arg
        For Each Arg in Wscript.Arguments
                Args=Args&Chr(&H20)&Chr(&H22)&Arg&Chr(&H22)
        Next
        CreateObject("Wscript.Shell").Run _
                strHost&Chr(&H20)&Chr(&H22)&WScript.ScriptFullName&Chr(&H22)&Args
        WScript.Quit
End If
 
 
Dim TYPES
Set TYPES = New MalTypes
 
Class MalTypes
        Public LIST, VECTOR, HASHMAP, [BOOLEAN], NIL
        Public KEYWORD, [STRING], NUMBER, SYMBOL
        Public PROCEDURE, ATOM
 
        Public [TypeName]
        Private Sub Class_Initialize
                [TypeName] = Array( _
                                "LIST", "VECTOR", "HASHMAP", "BOOLEAN", _
                                "NIL", "KEYWORD", "STRING", "NUMBER", _
                                "SYMBOL", "PROCEDURE", "ATOM")
 
                Dim i
                For i = 0 To UBound([TypeName])
                        Execute "[" + [TypeName](i) + "] = " + CStr(i)
                Next
        End Sub
End Class
 
Class MalType
        Public [Type]
        Public Value
 
        Private varMeta
        Public Property Get MetaData()
                If IsEmpty(varMeta) Then
                        Set MetaData = NewMalNil()
                Else
                        Set MetaData = varMeta
                End If
        End Property
        
        Public Property Set MetaData(objMeta)
                Set varMeta = objMeta
        End Property
        
        Public Function Copy()
                Set Copy = NewMalType([Type], Value)
        End Function
 
        Public Function Init(lngType, varValue)
                [Type] = lngType
                Value = varValue
        End Function
End Class
 
Function NewMalType(lngType, varValue)
        Dim varResult
        Set varResult = New MalType
        varResult.Init lngType, varValue
        Set NewMalType = varResult
End Function
 
Function NewMalBool(varValue)
        Set NewMalBool = NewMalType(TYPES.BOOLEAN, varValue)
End Function
 
Function NewMalNil()
        Set NewMalNil = NewMalType(TYPES.NIL, Empty)
End Function
 
Function NewMalKwd(varValue)
        Set NewMalKwd = NewMalType(TYPES.KEYWORD, varValue)
End Function
 
Function NewMalStr(varValue)
        Set NewMalStr = NewMalType(TYPES.STRING, varValue)
End Function
 
Function NewMalNum(varValue)
        Set NewMalNum = NewMalType(TYPES.NUMBER, varValue)
End Function
 
Function NewMalSym(varValue)
        Set NewMalSym = NewMalType(TYPES.SYMBOL, varValue)
End Function
 
Class MalAtom
        Public [Type]
        Public Value
        
        Private varMeta
        Public Property Get MetaData()
                If IsEmpty(varMeta) Then
                        Set MetaData = NewMalNil()
                Else
                        Set MetaData = varMeta
                End If
        End Property
        
        Public Property Set MetaData(objMeta)
                Set varMeta = objMeta
        End Property
 
        Public Function Copy()
                Set Copy = NewMalAtom(Value)
        End Function
 
        Public Sub Reset(objMal)
                Set Value = objMal
        End Sub
 
        Private Sub Class_Initialize
                [Type] = TYPES.ATOM
        End Sub
End Class
 
Function NewMalAtom(varValue)
        Dim varRes
        Set varRes = New MalAtom
        varRes.Reset varValue
        Set NewMalAtom = varRes
End Function
 
Class MalList ' Extends MalType
        Public [Type]
        Public Value
        
        Private varMeta
        Public Property Get MetaData()
                If IsEmpty(varMeta) Then
                        Set MetaData = NewMalNil()
                Else
                        Set MetaData = varMeta
                End If
        End Property
        
        Public Property Set MetaData(objMeta)
                Set varMeta = objMeta
        End Property
 
        Public Function Copy()
                Set Copy = New MalList
                Set Copy.Value = Value
        End Function
 
        Private Sub Class_Initialize
                [Type] = TYPES.LIST
                Set Value = CreateObject("System.Collections.ArrayList")
        End Sub
 
        Public Function Init(arrValues)
                Dim i
                For i = 0 To UBound(arrValues)
                        Add arrValues(i)
                Next
        End Function
 
        Public Function Add(objMalType)
                Value.Add objMalType
        End Function
        
        Public Property Get Item(i)
                Set Item = Value.Item(i)
        End Property
 
        Public Property Let Item(i, varValue)
                Value.Item(i) = varValue
        End Property
 
        Public Property Set Item(i, varValue)
                Set Value.Item(i) = varValue
        End Property
 
        Public Function Count()
                Count = Value.Count
        End Function
End Class
 
Function NewMalList(arrValues)
        Dim varResult
        Set varResult = New MalList
        varResult.Init arrValues
        Set NewMalList = varResult
End Function
 
Class MalVector ' Extends MalType
        Public [Type]
        Public Value
        
        Private varMeta
        Public Property Get MetaData()
                If IsEmpty(varMeta) Then
                        Set MetaData = NewMalNil()
                Else
                        Set MetaData = varMeta
                End If
        End Property
        
        Public Property Set MetaData(objMeta)
                Set varMeta = objMeta
        End Property
 
        Public Function Copy()
                Set Copy = New MalVector
                Set Copy.Value = Value
        End Function
 
        Private Sub Class_Initialize
                [Type] = TYPES.VECTOR
                Set Value = CreateObject("System.Collections.ArrayList")
        End Sub
 
        Public Function Init(arrValues)
                Dim i
                For i = 0 To UBound(arrValues)
                        Add arrValues(i)
                Next
        End Function
 
        Public Function Add(objMalType)
                Value.Add objMalType
        End Function
        
        Public Property Get Item(i)
                Set Item = Value.Item(i)
        End Property
 
        Public Property Let Item(i, varValue)
                Value.Item(i) = varValue
        End Property
 
        Public Property Set Item(i, varValue)
                Set Value.Item(i) = varValue
        End Property
 
        Public Function Count()
                Count = Value.Count
        End Function
End Class
 
Function NewMalVec(arrValues)
        Dim varResult
        Set varResult = New MalVector
        varResult.Init arrValues
        Set NewMalVec = varResult
End Function
 
Class MalHashmap 'Extends MalType
        Public [Type]
        Public Value
 
        Private varMeta
        Public Property Get MetaData()
                If IsEmpty(varMeta) Then
                        Set MetaData = NewMalNil()
                Else
                        Set MetaData = varMeta
                End If
        End Property
        
        Public Property Set MetaData(objMeta)
                Set varMeta = objMeta
        End Property
 
        Public Function Copy()
                Set Copy = New MalHashmap
                Set Copy.Value = Value
        End Function
 
 
        Private Sub Class_Initialize
                [Type] = TYPES.HASHMAP
                Set Value = CreateObject("Scripting.Dictionary")
        End Sub
 
        Public Function Init(arrKeys, arrValues)
                Dim i
                For i = 0 To UBound(arrKeys)
                        Add arrKeys(i), arrValues(i)
                Next
        End Function
 
        Private Function M2S(objKey)
                Dim varRes
                Select Case objKey.Type
                        Case TYPES.STRING
                                varRes = "S" + objKey.Value
                        Case TYPES.KEYWORD
                                varRes = "K" + objKey.Value
                        Case Else
                                Err.Raise vbObjectError, _
                                        "MalHashmap", "Unexpect key type."
                End Select
                M2S = varRes
        End Function
 
        Private Function S2M(strKey)
                Dim varRes
                Select Case Left(strKey, 1)
                        Case "S"
                                Set varRes = NewMalStr(Right(strKey, Len(strKey) - 1))
                        Case "K"
                                Set varRes = NewMalKwd(Right(strKey, Len(strKey) - 1))
                        Case Else
                                Err.Raise vbObjectError, _
                                        "MalHashmap", "Unexpect key type."
                End Select
                Set S2M = varRes
        End Function
 
        Public Function Add(varKey, varValue)
                If varKey.Type <> TYPES.STRING And _
                        varKey.Type <> TYPES.KEYWORD Then
                        Err.Raise vbObjectError, _
                                "MalHashmap", "Unexpect key type."
                End If
                
                Set Value.Item(M2S(varKey)) = varValue
                'Value.Add M2S(varKey), varValue
        End Function
        
        Public Property Get Keys()
                Dim aKeys
                aKeys = Value.Keys
                Dim aRes()
                ReDim aRes(UBound(aKeys))
                Dim i
                For i = 0 To UBound(aRes)
                        Set aRes(i) = S2M(aKeys(i))
                Next
 
                Keys = aRes
        End Property
 
        Public Function Count()
                Count = Value.Count
        End Function
 
        Public Property Get Item(i)
                Set Item = Value.Item(M2S(i))
        End Property
 
        Public Function Exists(varKey)
                If varKey.Type <> TYPES.STRING And _
                        varKey.Type <> TYPES.KEYWORD Then
                        Err.Raise vbObjectError, _
                                "MalHashmap", "Unexpect key type."
                End If
                Exists = Value.Exists(M2S(varKey))
        End Function
 
        Public Property Let Item(i, varValue)
                Value.Item(M2S(i)) = varValue
        End Property
 
        Public Property Set Item(i, varValue)
                Set Value.Item(M2S(i)) = varValue
        End Property
End Class
 
Function NewMalMap(arrKeys, arrValues)
        Dim varResult
        Set varResult = New MalHashmap
        varResult.Init arrKeys, arrValues
        Set NewMalMap = varResult
End Function
 
Class VbsProcedure 'Extends MalType
        Public [Type]
        Public Value
        
        Public IsMacro
        Public boolSpec
        Public MetaData
        Private Sub Class_Initialize
                [Type] = TYPES.PROCEDURE
                IsMacro = False
                Set MetaData = NewMalNil()
        End Sub
 
        Public Property Get IsSpecial()
                IsSpecial = boolSpec
        End Property
 
        Public Function Init(objFunction, boolIsSpec)
                Set Value = objFunction
                boolSpec = boolIsSpec
        End Function
 
        Public Function Apply(objArgs, objEnv)
                Dim varResult
                If boolSpec Then
                        Set varResult = Value(objArgs, objEnv)
                Else
                        Set varResult = Value(EvaluateRest(objArgs, objEnv), objEnv)
                End If
                Set Apply = varResult
        End Function
 
        Public Function ApplyWithoutEval(objArgs, objEnv)
                Dim varResult
                Set varResult = Value(objArgs, objEnv)
                
                Set ApplyWithoutEval = varResult
        End Function
 
        Public Function Copy()
                Dim varRes
                Set varRes = New VbsProcedure
                varRes.Type = [Type]
                Set varRes.Value = Value
                varRes.IsMacro = IsMacro
                varRes.boolSpec = boolSpec
                Set Copy = varRes
        End Function
End Class
 
Function NewVbsProc(strFnName, boolSpec)
        Dim varResult
        Set varResult = New VbsProcedure
        varResult.Init GetRef(strFnName), boolSpec
        Set NewVbsProc = varResult
End Function
 
Class MalProcedure 'Extends MalType
        Public [Type]
        Public Value
        
        Public IsMacro
 
        Public Property Get IsSpecial()
                IsSpecial = False
        End Property
 
        Public MetaData
        Private Sub Class_Initialize
                [Type] = TYPES.PROCEDURE
                IsMacro = False
                Set MetaData = NewMalNil()
        End Sub
 
        Public objParams, objCode, objSavedEnv
        Public Function Init(objP, objC, objE)
                Set objParams = objP
                Set objCode = objC
                Set objSavedEnv = objE
        End Function
 
        Public Function Apply(objArgs, objEnv)
                If IsMacro Then
                        Err.Raise vbObjectError, _
                                "MalProcedureApply", "Not a procedure."
                End If
 
                Dim varRet
                Dim objNewEnv
                Set objNewEnv = NewEnv(objSavedEnv)
                Dim i
                i = 0
                Dim objList
                While i < objParams.Count
                        If objParams.Item(i).Value = "&" Then
                                If objParams.Count - 1 = i + 1 Then
                                        Set objList = NewMalList(Array())
                                        objNewEnv.Add objParams.Item(i + 1), objList
                                        While i + 1 < objArgs.Count
                                                objList.Add Evaluate(objArgs.Item(i + 1), objEnv)
                                                i = i + 1
                                        Wend
                                        i = objParams.Count ' Break While
                                Else
                                        Err.Raise vbObjectError, _
                                                "MalProcedureApply", "Invalid parameter(s)."
                                End If
                        Else
                                If i + 1 >= objArgs.Count Then
                                        Err.Raise vbObjectError, _
                                                "MalProcedureApply", "Need more arguments."
                                End If
                                objNewEnv.Add objParams.Item(i), _
                                        Evaluate(objArgs.Item(i + 1), objEnv)
                                i = i + 1
                        End If
                Wend
                
                Set varRet = EvalLater(objCode, objNewEnv)
                Set Apply = varRet
        End Function
 
        Public Function MacroApply(objArgs, objEnv)
                If Not IsMacro Then
                        Err.Raise vbObjectError, _
                                "MalMacroApply", "Not a macro."
                End If
 
                Dim varRet
                Dim objNewEnv
                Set objNewEnv = NewEnv(objSavedEnv)
                Dim i
                i = 0
                Dim objList
                While i < objParams.Count
                        If objParams.Item(i).Value = "&" Then
                                If objParams.Count - 1 = i + 1 Then
                                        Set objList = NewMalList(Array())
                                        
                                        ' No evaluation
                                        objNewEnv.Add objParams.Item(i + 1), objList
                                        While i + 1 < objArgs.Count
                                                objList.Add objArgs.Item(i + 1)
                                                i = i + 1
                                        Wend
                                        i = objParams.Count ' Break While
                                Else
                                        Err.Raise vbObjectError, _
                                                "MalMacroApply", "Invalid parameter(s)."
                                End If
                        Else
                                If i + 1 >= objArgs.Count Then
                                        Err.Raise vbObjectError, _
                                                "MalMacroApply", "Need more arguments."
                                End If
                                
                                ' No evaluation
                                objNewEnv.Add objParams.Item(i), _
                                        objArgs.Item(i + 1)
                                i = i + 1
                        End If
                Wend
                
                ' EvalLater -> Evaluate
                Set varRet = Evaluate(objCode, objNewEnv)
                Set MacroApply = varRet
        End Function
 
 
        Public Function ApplyWithoutEval(objArgs, objEnv)
                Dim varRet
                Dim objNewEnv
                Set objNewEnv = NewEnv(objSavedEnv)
                Dim i
                i = 0
                Dim objList
                While i < objParams.Count
                        If objParams.Item(i).Value = "&" Then
                                If objParams.Count - 1 = i + 1 Then
                                        Set objList = NewMalList(Array())
                                        
                                        ' No evaluation
                                        objNewEnv.Add objParams.Item(i + 1), objList
                                        While i + 1 < objArgs.Count
                                                objList.Add objArgs.Item(i + 1)
                                                i = i + 1
                                        Wend
                                        i = objParams.Count ' Break While
                                Else
                                        Err.Raise vbObjectError, _
                                                "MalMacroApply", "Invalid parameter(s)."
                                End If
                        Else
                                If i + 1 >= objArgs.Count Then
                                        Err.Raise vbObjectError, _
                                                "MalMacroApply", "Need more arguments."
                                End If
                                
                                ' No evaluation
                                objNewEnv.Add objParams.Item(i), _
                                        objArgs.Item(i + 1)
                                i = i + 1
                        End If
                Wend
                
                ' EvalLater -> Evaluate
                Set varRet = Evaluate(objCode, objNewEnv)
                Set ApplyWithoutEval = varRet
        End Function
 
        
        Public Function Copy()
                Dim varRes
                Set varRes = New MalProcedure
                varRes.Type = [Type]
                varRes.Value = Value
                varRes.IsMacro = IsMacro
                Set varRes.objParams = objParams
                Set varRes.objCode = objCode
                Set varRes.objSavedEnv = objSavedEnv
                Set Copy = varRes
        End Function
End Class
 
Function NewMalProc(objParams, objCode, objEnv)
        Dim varRet
        Set varRet = New MalProcedure
        varRet.Init objParams, objCode, objEnv
        Set NewMalProc = varRet
End Function
 
Function NewMalMacro(objParams, objCode, objEnv)
        Dim varRet
        Set varRet = New MalProcedure
        varRet.Init objParams, objCode, objEnv
        varRet.IsMacro = True
        Set NewMalProc = varRet
End Function
 
Function SetMeta(objMal, objMeta)
        Dim varRes
        Set varRes = objMal.Copy
        Set varRes.MetaData = objMeta
        Set SetMeta = varRes
End Function
 
Function GetMeta(objMal)
        Set GetMeta = objMal.MetaData
End Function
 
 
Function ReadString(strCode)
        Dim objTokens
        Set objTokens = Tokenize(strCode)
        Set ReadString = ReadForm(objTokens)
        If Not objTokens.AtEnd() Then
                Err.Raise vbObjectError, _
                        "ReadForm", "extra token '" + objTokens.Current() + "'."
        End If
End Function
 
Class Tokens
        Private objQueue
        Private objRE
 
        Private Sub Class_Initialize
                Set objRE = New RegExp
                With objRE
                        .Pattern = "[\s,]*" + _
                                "(" + _
                                        "~@" + "|" + _
                                        "[\[\]{}()'`~^@]" + "|" + _
                                        """(?:\\.|[^\\""])*""?" + "|" + _
                                        ";.*" + "|" + _
                                        "[^\s\[\]{}('""`,;)]*" + _
                                ")"
                        .IgnoreCase = True
                        .Global = True
                End With
 
                Set objQueue = CreateObject("System.Collections.Queue")
        End Sub
 
        Public Function Init(strCode)
                Dim objMatches, objMatch
                Set objMatches = objRE.Execute(strCode)
                Dim strToken
                For Each objMatch In objMatches
                        strToken = Trim(objMatch.SubMatches(0))
                        If Not (Left(strToken, 1) = ";" Or strToken = "") Then
                                objQueue.Enqueue strToken
                        End If
                Next
        End Function
 
        Public Function Current()
                Current = objQueue.Peek()
        End Function
 
        Public Function MoveToNext()
                MoveToNext = objQueue.Dequeue()
        End Function
 
        Public Function AtEnd()
                AtEnd = (objQueue.Count = 0)
        End Function
 
        Public Function Count()
                Count = objQueue.Count
        End Function
End Class
 
Function Tokenize(strCode) ' Return objTokens
        Dim varResult
        Set varResult = New Tokens
        varResult.Init strCode
        Set Tokenize = varResult
End Function
 
Function ReadForm(objTokens) ' Return Nothing / MalType
        If objTokens.AtEnd() Then
                Set ReadForm = Nothing
                Exit Function
        End If
 
        Dim strToken
        strToken = objTokens.Current()
 
        Dim varResult
        If InStr("([{", strToken) Then
                Select Case strToken
                        Case "("
                                Set varResult = ReadList(objTokens)
                        Case "["
                                Set varResult = ReadVector(objTokens)
                        Case "{"
                                Set varResult = ReadHashmap(objTokens)
                End Select
        ElseIf InStr("'`~@", strToken) Then
                Set varResult = ReadSpecial(objTokens)
        ElseIf InStr(")]}", strToken) Then
                Err.Raise vbObjectError, _
                        "ReadForm", "unbalanced parentheses."
        ElseIf strToken = "^" Then
                Set varResult = ReadMetadata(objTokens)
        Else
                Set varResult = ReadAtom(objTokens)
        End If
 
        Set ReadForm = varResult
End Function
 
Function ReadMetadata(objTokens)
        Dim varResult
 
        Call objTokens.MoveToNext()
        Dim objTemp
        Set objTemp = ReadForm(objTokens)
        Set varResult = NewMalList(Array( _
                NewMalSym("with-meta"), _
                ReadForm(objTokens), objTemp))
 
        Set ReadMetadata = varResult
End Function
 
Function ReadSpecial(objTokens)
        Dim varResult
 
        Dim strToken, strAlias
        strToken = objTokens.Current()
        Select Case strToken
                Case "'"
                        strAlias = "quote"
                Case "`"
                        strAlias = "quasiquote"
                Case "~"
                        strAlias = "unquote"
                Case "~@"
                        strAlias = "splice-unquote"
                Case "@"
                        strAlias = "deref"
                Case Else
                        Err.Raise vbObjectError, _
                                "ReadSpecial", "unknown token '" & strAlias & "'."
        End Select
 
        Call objTokens.MoveToNext()
        Set varResult = NewMalList(Array( _
                NewMalSym(strAlias), _ 
                ReadForm(objTokens)))
 
        Set ReadSpecial = varResult
End Function
 
Function ReadList(objTokens)
        Dim varResult
        Call objTokens.MoveToNext()
 
        If objTokens.AtEnd() Then
                Err.Raise vbObjectError, _
                        "ReadList", "unbalanced parentheses."
        End If
 
        Set varResult = NewMalList(Array())
        With varResult
                While objTokens.Count() > 1 And objTokens.Current() <> ")"
                        .Add ReadForm(objTokens)
                Wend
        End With
 
        If objTokens.MoveToNext() <> ")" Then
                Err.Raise vbObjectError, _
                        "ReadList", "unbalanced parentheses."
        End If
 
        Set ReadList = varResult
End Function
 
Function ReadVector(objTokens)
        Dim varResult
        Call objTokens.MoveToNext()
 
        If objTokens.AtEnd() Then
                Err.Raise vbObjectError, _
                        "ReadVector", "unbalanced parentheses."
        End If
 
        Set varResult = NewMalVec(Array())
        With varResult
                While objTokens.Count() > 1 And objTokens.Current() <> "]"
                        .Add ReadForm(objTokens)
                Wend
        End With
 
        If objTokens.MoveToNext() <> "]" Then
                Err.Raise vbObjectError, _
                        "ReadVector", "unbalanced parentheses."
        End If
 
        Set ReadVector = varResult
End Function
 
Function ReadHashmap(objTokens)
        Dim varResult
        Call objTokens.MoveToNext()
 
        If objTokens.Count = 0 Then
                Err.Raise vbObjectError, _
                        "ReadHashmap", "unbalanced parentheses."
        End If
        
        Set varResult = NewMalMap(Array(), Array())
        Dim objKey, objValue
        With varResult
                While objTokens.Count > 2 And objTokens.Current() <> "}"
                        Set objKey = ReadForm(objTokens)
                        Set objValue = ReadForm(objTokens)
                        .Add objKey, objValue
                Wend
        End With
        
        If objTokens.MoveToNext() <> "}" Then
                Err.Raise vbObjectError, _
                        "ReadHashmap", "unbalanced parentheses."
        End If
        
        Set ReadHashmap = varResult
End Function
 
Function ReadAtom(objTokens)
        Dim varResult
 
        Dim strAtom
        strAtom = objTokens.MoveToNext()
 
        Select Case strAtom
                Case "true"
                        Set varResult = NewMalBool(True)
                Case "false"
                        Set varResult = NewMalBool(False)
                Case "nil"
                        Set varResult = NewMalNil()
                Case Else
                        Select Case Left(strAtom, 1)
                                Case ":"
                                        Set varResult = NewMalKwd(strAtom)
                                Case """"
                                        Set varResult = NewMalStr(ParseString(strAtom))
                                Case Else
                                        If IsNumeric(strAtom) Then
                                                Set varResult = NewMalNum(Eval(strAtom))
                                        Else
                                                Set varResult = NewMalSym(strAtom)
                                        End If
                        End Select
        End Select
 
        Set ReadAtom = varResult
End Function
 
Function ParseString(strRaw)
        If Right(strRaw, 1) <> """" Or Len(strRaw) < 2 Then
                Err.Raise vbObjectError, _
                        "ParseString", "unterminated string, got EOF."
        End If
 
        Dim strTemp
        strTemp = Mid(strRaw, 2, Len(strRaw) - 2)
        Dim i
        i = 1
        ParseString = ""
        While i <= Len(strTemp) - 1
                Select Case Mid(strTemp, i, 2)
                        Case "\\"
                                ParseString = ParseString & "\"
                        Case "\n"
                                ParseString = ParseString & vbCrLf
                        Case "\"""
                                ParseString = ParseString & """"
                        Case Else
                                ParseString = ParseString & Mid(strTemp, i, 1)
                                i = i - 1
                End Select
                i = i + 2
        Wend
 
        If i <= Len(strTemp) Then
                ' Last char is not processed.
                If Right(strTemp, 1) <> "\" Then
                        ParseString = ParseString & Right(strTemp, 1)
                Else
                        Err.Raise vbObjectError, _
                                "ParseString", "unterminated string, got EOF."
                End If
        End If
End Function
 
 
Function PrintMalType(objMal, boolReadable)
        Dim varResult
 
        varResult = ""
 
        If TypeName(objMal) = "Nothing" Then
                PrintMalType = ""
                Exit Function
        End If
        
        Dim i
        Select Case objMal.Type
                Case TYPES.LIST
                        With objMal
                                For i = 0 To .Count - 2
                                        varResult = varResult & _
                                                PrintMalType(.Item(i), boolReadable) & " "
                                Next
                                If .Count > 0 Then
                                        varResult = varResult & _
                                                PrintMalType(.Item(.Count - 1), boolReadable)
                                End If
                        End With
                        varResult = "(" & varResult & ")"
                Case TYPES.VECTOR
                        With objMal
                                For i = 0 To .Count - 2
                                        varResult = varResult & _
                                                PrintMalType(.Item(i), boolReadable) & " "
                                Next
                                If .Count > 0 Then
                                        varResult = varResult & _
                                                PrintMalType(.Item(.Count - 1), boolReadable)
                                End If
                        End With
                        varResult = "[" & varResult & "]"
                Case TYPES.HASHMAP
                        With objMal
                                Dim arrKeys
                                arrKeys = .Keys
                                For i = 0 To .Count - 2
                                        varResult = varResult & _
                                                PrintMalType(arrKeys(i), boolReadable) & " " & _
                                                PrintMalType(.Item(arrKeys(i)), boolReadable) & " "
                                Next
                                If .Count > 0 Then
                                        varResult = varResult & _
                                                PrintMalType(arrKeys(.Count - 1), boolReadable) & " " & _
                                                PrintMalType(.Item(arrKeys(.Count - 1)), boolReadable)
                                End If
                        End With
                        varResult = "{" & varResult & "}"
                Case TYPES.STRING
                        If boolReadable Then
                                varResult = EscapeString(objMal.Value)
                        Else
                                varResult = objMal.Value
                        End If
                Case TYPES.BOOLEAN
                        If objMal.Value Then
                                varResult = "true"
                        Else
                                varResult = "false"
                        End If
                Case TYPES.NIL
                        varResult = "nil"
                Case TYPES.NUMBER
                        varResult = CStr(objMal.Value)
                Case TYPES.PROCEDURE
                        varResult = "#<function>"
                Case TYPES.KEYWORD
                        varResult = objMal.Value
                Case TYPES.SYMBOL
                        varResult = objMal.Value
                Case TYPES.ATOM
                        varResult = "(atom " + PrintMalType(objMal.Value, boolReadable) + ")"
                Case Else
                        Err.Raise vbObjectError, _
                                "PrintMalType", "Unknown type."
        End Select
 
        PrintMalType = varResult
End Function
 
Function EscapeString(strRaw)
        EscapeString = strRaw
        EscapeString = Replace(EscapeString, "\", "\\")
        EscapeString = Replace(EscapeString, vbCrLf, "\n")
        EscapeString = Replace(EscapeString, """", "\""")
        EscapeString = """" & EscapeString & """"
End Function
 
Function NewEnv(objOuter)
        Dim varRet
        Set varRet = New Environment
        Set varRet.Self = varRet
        Set varRet.Outer = objOuter
        Set NewEnv = varRet
End Function
 
Class Environment
        Private objOuter, objSelf
        Private objBinds
        Private Sub Class_Initialize()
                Set objBinds = CreateObject("Scripting.Dictionary")
                Set objOuter = Nothing
                Set objSelf = Nothing
        End Sub
        
        Public Property Set Outer(objEnv)
                Set objOuter = objEnv
        End Property
 
        Public Property Get Outer()
                Set Outer = objOuter
        End Property
 
        Public Property Set Self(objEnv)
                Set objSelf = objEnv
        End Property
        
        Public Sub Add(varKey, varValue)
                Set objBinds.Item(varKey.Value) = varValue
        End Sub
 
        Public Function Find(varKey)
                Dim varRet
                If objBinds.Exists(varKey.Value) Then
                        Set varRet = objSelf
                Else
                        If TypeName(objOuter) <> "Nothing" Then
                                Set varRet = objOuter.Find(varKey)
                        Else
                                Err.Raise vbObjectError, _
                                        "Environment", "'" + varKey.Value + "' not found"
                        End If
                End If
 
                Set Find = varRet
        End Function
        
        Public Function [Get](varKey)
                Dim objEnv, varRet
                Set objEnv = Find(varKey)
                If objEnv Is objSelf Then
                        Set varRet = objBinds(varKey.Value)
                Else
                        Set varRet = objEnv.Get(varKey)
                End If
                
                Set [Get] = varRet
        End Function
End Class
 
Sub CheckArgNum(objArgs, lngArgNum)
        If objArgs.Count - 1 <> lngArgNum Then
                Err.Raise vbObjectError, _
                        "CheckArgNum", "Wrong number of arguments."
        End IF
End Sub
 
Sub CheckType(objMal, varType)
        If objMal.Type <> varType Then
                Err.Raise vbObjectError, _
                        "CheckType", "Wrong argument type."
        End IF
End Sub
 
Function IsListOrVec(objMal)
        IsListOrVec = _
                objMal.Type = TYPES.LIST Or _
                objMal.Type = TYPES.VECTOR
End Function
 
Sub CheckListOrVec(objMal)
        If Not IsListOrVec(objMal) Then
                Err.Raise vbObjectError, _
                        "CheckListOrVec", _
                        "Wrong argument type, need a list or a vector."
        End If
End Sub
 
Dim objNS
Set objNS = NewEnv(Nothing)
 
Function MAdd(objArgs, objEnv)
        CheckArgNum objArgs, 2
        CheckType objArgs.Item(1), TYPES.NUMBER
        CheckType objArgs.Item(2), TYPES.NUMBER
        Set MAdd = NewMalNum( _
                objArgs.Item(1).Value + objArgs.Item(2).Value)
End Function
objNS.Add NewMalSym("+"), NewVbsProc("MAdd", False)
 
Function MSub(objArgs, objEnv)
        CheckArgNum objArgs, 2
        CheckType objArgs.Item(1), TYPES.NUMBER
        CheckType objArgs.Item(2), TYPES.NUMBER
        Set MSub = NewMalNum( _
                objArgs.Item(1).Value - objArgs.Item(2).Value)
End Function
objNS.Add NewMalSym("-"), NewVbsProc("MSub", False)
 
Function MMul(objArgs, objEnv)
        CheckArgNum objArgs, 2
        CheckType objArgs.Item(1), TYPES.NUMBER
        CheckType objArgs.Item(2), TYPES.NUMBER
        Set MMul = NewMalNum( _
                objArgs.Item(1).Value * objArgs.Item(2).Value)
End Function
objNS.Add NewMalSym("*"), NewVbsProc("MMul", False)
 
Function MDiv(objArgs, objEnv)
        CheckArgNum objArgs, 2
        CheckType objArgs.Item(1), TYPES.NUMBER
        CheckType objArgs.Item(2), TYPES.NUMBER
        Set MDiv = NewMalNum( _
                objArgs.Item(1).Value \ objArgs.Item(2).Value)
End Function
objNS.Add NewMalSym("/"), NewVbsProc("MDiv", False)
 
Function MList(objArgs, objEnv)
        Dim varRet
        Set varRet = NewMalList(Array())
        Dim i
        For i = 1 To objArgs.Count - 1
                varRet.Add objArgs.Item(i)
        Next
        Set MList = varRet
End Function
objNS.Add NewMalSym("list"), NewVbsProc("MList", False)
 
Function MIsList(objArgs, objEnv)
        CheckArgNum objArgs, 1
 
        Set MIsList = NewMalBool(objArgs.Item(1).Type = TYPES.LIST)
End Function
objNS.Add NewMalSym("list?"), NewVbsProc("MIsList", False)
 
Function MIsEmpty(objArgs, objEnv)
        CheckArgNum objArgs, 1
        CheckListOrVec objArgs.Item(1)
 
        Set MIsEmpty = NewMalBool(objArgs.Item(1).Count = 0)
End Function
objNS.Add NewMalSym("empty?"), NewVbsProc("MIsEmpty", False)
 
Function MCount(objArgs, objEnv)
        CheckArgNum objArgs, 1
        If objArgs.Item(1).Type = TYPES.NIL Then
                Set MCount = NewMalNum(0)
        Else
                CheckListOrVec objArgs.Item(1)
                Set MCount = NewMalNum(objArgs.Item(1).Count)
        End If
End Function
objNS.Add NewMalSym("count"), NewVbsProc("MCount", False)
 
Function MEqual(objArgs, objEnv)
        Dim varRet
        CheckArgNum objArgs, 2
 
        Dim boolResult, i
        If IsListOrVec(objArgs.Item(1)) And _
                IsListOrVec(objArgs.Item(2)) Then
                If objArgs.Item(1).Count <> objArgs.Item(2).Count Then
                        Set varRet = NewMalBool(False)
                Else
                        boolResult = True
                        For i = 0 To objArgs.Item(1).Count - 1
                                boolResult = boolResult And _
                                        MEqual(NewMalList(Array(Nothing, _
                                        objArgs.Item(1).Item(i), _
                                        objArgs.Item(2).Item(i))), objEnv).Value
                        Next
                        Set varRet = NewMalBool(boolResult)        
                End If
        Else
                If objArgs.Item(1).Type <> objArgs.Item(2).Type Then
                        Set varRet = NewMalBool(False)
                Else
                        Select Case objArgs.Item(1).Type
                                Case TYPES.HASHMAP
                                        'Err.Raise vbObjectError, _
                                        '        "MEqual", "Not implement yet~"
                                        If UBound(objArgs.Item(1).Keys) <> UBound(objArgs.Item(2).Keys) Then
                                                Set varRet = NewMalBool(False)
                                                Set MEqual = varRet
                                                Exit Function
                                        End If
                                        
                                        boolResult = True
                                        For Each i In objArgs.Item(1).Keys
                                                If Not objArgs.Item(2).Exists(i) Then
                                                        Set varRet = NewMalBool(False)
                                                        Set MEqual = varRet
                                                        Exit Function
                                                End If
 
                                                boolResult = boolResult And _
                                                        MEqual(NewMalList(Array(Nothing, objArgs.Item(1).Item(i), objArgs.Item(2).Item(i))), objEnv).Value
                                        Next
                                        Set varRet = NewMalBool(boolResult)        
                                        
                                Case Else
                                        Set varRet = NewMalBool( _
                                                objArgs.Item(1).Value = objArgs.Item(2).Value)
                        End Select
                End If
        End If
 
        Set MEqual = varRet
End Function
objNS.Add NewMalSym("="), NewVbsProc("MEqual", False)
 
Function MGreater(objArgs, objEnv)
        Dim varRet
        CheckArgNum objArgs, 2
        CheckType objArgs.Item(1), TYPES.NUMBER
        CheckType objArgs.Item(2), TYPES.NUMBER
        Set varRet = NewMalBool( _
                objArgs.Item(1).Value > objArgs.Item(2).Value)
        Set MGreater = varRet
End Function
objNS.Add NewMalSym(">"), NewVbsProc("MGreater", False)
 
Function MPrStr(objArgs, objEnv)
        Dim varRet
        Dim strRet
        strRet = ""
        Dim i
        If objArgs.Count - 1 >= 1 Then
                strRet = PrintMalType(objArgs.Item(1), True)
        End If
        For i = 2 To objArgs.Count - 1
                strRet = strRet + " " + _
                        PrintMalType(objArgs.Item(i), True)
        Next
        Set varRet = NewMalStr(strRet)
        Set MPrStr = varRet
End Function
objNS.Add NewMalSym("pr-str"), NewVbsProc("MPrStr", False)
 
Function MStr(objArgs, objEnv)
        Dim varRet
        Dim strRet
        strRet = ""
        Dim i
        For i = 1 To objArgs.Count - 1
                strRet = strRet + _
                        PrintMalType(objArgs.Item(i), False)
        Next
        Set varRet = NewMalStr(strRet)
        Set MStr = varRet
End Function
objNS.Add NewMalSym("str"), NewVbsProc("MStr", False)
 
Function MPrn(objArgs, objEnv)
        Dim varRet
        Dim objStr
        Set objStr = MPrStr(objArgs, objEnv)
        WScript.StdOut.WriteLine objStr.Value
        Set varRet = NewMalNil()
        Set MPrn = varRet
End Function
objNS.Add NewMalSym("prn"), NewVbsProc("MPrn", False)
 
Function MPrintln(objArgs, objEnv)
        Dim varRet
        Dim strRes
        strRes = ""
        Dim i
        If objArgs.Count - 1 >= 1 Then
                strRes = PrintMalType(objArgs.Item(1), False)
        End If
        For i = 2 To objArgs.Count - 1
                strRes = strRes + " " + _
                        PrintMalType(objArgs.Item(i), False)
        Next
        WScript.StdOut.WriteLine strRes
        Set varRet = NewMalNil()
        Set MPrintln = varRet
End Function
objNS.Add NewMalSym("println"), NewVbsProc("MPrintln", False)
 
Sub InitBuiltIn()
        REP "(def! not (fn* [bool] (if bool false true)))"
        REP "(def! <= (fn* [a b] (not (> a b))))"
        REP "(def! < (fn* [a b] (> b a)))"
        REP "(def! >= (fn* [a b] (not (> b a))))"
        REP "(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"
        REP "(def! cons (fn* [a b] (concat (list a) b)))"
        REP "(def! nil? (fn* [x] (= x nil)))"
        REP "(def! true? (fn* [x] (= x true)))"
        REP "(def! false? (fn* [x] (= x false)))"
        REP "(def! vector (fn* [& args] (vec args)))"
        REP "(def! vals (fn* [hmap] (map (fn* [key] (get hmap key)) (keys hmap))))"
        REP "(def! *host-language* ""VBScript"")"
End Sub
 
Function MReadStr(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        CheckType objArgs.Item(1), TYPES.STRING
 
        Set varRes = ReadString(objArgs.Item(1).Value)
        If TypeName(varRes) = "Nothing" Then
                Set varRes = NewMalNil()
        End If
        Set MReadStr = varRes
End Function
objNS.Add NewMalSym("read-string"), NewVbsProc("MReadStr", False)
 
Function MSlurp(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        CheckType objArgs.Item(1), TYPES.STRING
 
        Dim strRes
        With CreateObject("Scripting.FileSystemObject")
                strRes = .OpenTextFile( _
                        .GetParentFolderName( _
                        .GetFile(WScript.ScriptFullName)) & _
                        "\" & objArgs.Item(1).Value).ReadAll
        End With
 
        Set varRes = NewMalStr(strRes)
        Set MSlurp = varRes
End Function
objNS.Add NewMalSym("slurp"), NewVbsProc("MSlurp", False)
 
Function MAtom(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
 
        Set varRes = NewMalAtom(objArgs.Item(1))
        Set MAtom = varRes
End Function
objNS.Add NewMalSym("atom"), NewVbsProc("MAtom", False)
 
Function MIsAtom(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
 
        Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.ATOM)
        Set MIsAtom = varRes
End Function
objNS.Add NewMalSym("atom?"), NewVbsProc("MIsAtom", False)
 
Function MDeref(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        CheckType objArgs.Item(1), TYPES.ATOM
 
        Set varRes = objArgs.Item(1).Value
        Set MDeref = varRes
End Function
objNS.Add NewMalSym("deref"), NewVbsProc("MDeref", False)
 
Function MReset(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 2
        CheckType objArgs.Item(1), TYPES.ATOM
 
        objArgs.Item(1).Reset objArgs.Item(2)
        Set varRes = objArgs.Item(2)
        Set MReset = varRes
End Function
objNS.Add NewMalSym("reset!"), NewVbsProc("MReset", False)
 
Function MSwap(objArgs, objEnv)
        Dim varRes
        If objArgs.Count - 1 < 2 Then
                Err.Raise vbObjectError, _
                        "MSwap", "Need more arguments."
        End If
 
        Dim objAtom, objFn
        Set objAtom = objArgs.Item(1)
        CheckType objAtom, TYPES.ATOM
        Set objFn = objArgs.Item(2)
        CheckType objFn, TYPES.PROCEDURE
 
        Dim objProg
        Set objProg = NewMalList(Array(objFn))
        objProg.Add objAtom.Value
        Dim i
        For i = 3 To objArgs.Count - 1
                objProg.Add objArgs.Item(i)
        Next
 
        objAtom.Reset objFn.ApplyWithoutEval(objProg, objEnv)
        Set varRes = objAtom.Value
        Set MSwap = varRes
End Function
objNS.Add NewMalSym("swap!"), NewVbsProc("MSwap", False)
 
Function MConcat(objArgs, objEnv)
        Dim varRes
        Dim i, j
        Set varRes = NewMalList(Array())
        For i = 1 To objArgs.Count - 1
                If Not IsListOrVec(objArgs.Item(i)) Then
                        Err.Raise vbObjectError, _
                                "MConcat", "Invaild argument(s)."
                End If
                
                For j = 0 To objArgs.Item(i).Count - 1
                        varRes.Add objArgs.Item(i).Item(j)
                Next
        Next
        Set MConcat = varRes
End Function
objNS.Add NewMalSym("concat"), NewVbsProc("MConcat", False)
 
Function MVec(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        CheckListOrVec objArgs.Item(1)
        Set varRes = NewMalVec(Array())
        Dim i
        For i = 0 To objArgs.Item(1).Count - 1
                varRes.Add objArgs.Item(1).Item(i)
        Next
        Set MVec = varRes
End Function
objNS.Add NewMalSym("vec"), NewVbsProc("MVec", False)
 
Function MNth(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 2
        CheckListOrVec objArgs.Item(1)
        CheckType objArgs.Item(2), TYPES.NUMBER
 
        If objArgs.Item(2).Value < objArgs.Item(1).Count Then
                Set varRes = objArgs.Item(1).Item(objArgs.Item(2).Value)
        Else
                Err.Raise vbObjectError, _
                        "MNth", "Index out of bounds."
        End If
 
        Set MNth = varRes
End Function
objNS.Add NewMalSym("nth"), NewVbsProc("MNth", False)
 
Function MFirst(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        
        If objArgs.Item(1).Type = TYPES.NIL Then
                Set varRes = NewMalNil()
                Set MFirst = varRes
                Exit Function
        End If
 
        CheckListOrVec objArgs.Item(1)
 
        If objArgs.Item(1).Count < 1 Then
                Set varRes = NewMalNil()
        Else
                Set varRes = objArgs.Item(1).Item(0)
        End If
 
        Set MFirst = varRes
End Function
objNS.Add NewMalSym("first"), NewVbsProc("MFirst", False)
 
Function MRest(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        
        If objArgs.Item(1).Type = TYPES.NIL Then
                Set varRes = NewMalList(Array())
                Set MRest = varRes
                Exit Function
        End If
 
        Dim objList
        Set objList = objArgs.Item(1)
        CheckListOrVec objList
 
        Set varRes = NewMalList(Array())
        Dim i
        For i = 1 To objList.Count - 1
                varRes.Add objList.Item(i)
        Next
        
        Set MRest = varRes
End Function
objNS.Add NewMalSym("rest"), NewVbsProc("MRest", False)
 
Sub InitMacro()
        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))))))))"
        REP "(def! *gensym-counter* (atom 0))"
        REP "(def! gensym (fn* [] (symbol (str ""G__"" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))"
        REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))"
End Sub
 
Class MalException
        Private objDict
        Private Sub Class_Initialize
                Set objDict = CreateObject("Scripting.Dictionary")
        End Sub
 
        Public Sub Add(varKey, varValue)
                objDict.Add varKey, varValue
        End Sub
 
        Public Function Item(varKey)
                Set Item = objDict.Item(varKey)
        End Function
 
        Public Sub Remove(varKey)
                objDict.Remove varKey
        End Sub
End Class
 
Dim objExceptions
Set objExceptions = New MalException
 
Function MThrow(objArgs, objEnv)
        CheckArgNum objArgs, 1
        Dim strRnd
        strRnd = CStr(Rnd())
        objExceptions.Add strRnd, objArgs.Item(1)
        Err.Raise vbObjectError, _
                "MThrow", strRnd
End Function
objNS.Add NewMalSym("throw"), NewVbsProc("MThrow", False)
 
Function MApply(objArgs, objEnv)
        Dim varRes
        If objArgs.Count - 1 < 2 Then
                Err.Raise vbObjectError, _
                        "MApply", "Need more arguments."
        End If
        
        Dim objFn
        Set objFn = objArgs.Item(1)
        CheckType objFn, TYPES.PROCEDURE
        If objFn.IsSpecial Or objFn.IsMacro Then
                Err.Raise vbObjectError, _
                        "MApply", "Need a function."
        End If
 
        Dim objAST
        Set objAST = NewMalList(Array(objFn))
        Dim i
        For i = 2 To objArgs.Count - 2
                objAST.Add objArgs.Item(i)
        Next
 
        Dim objSeq
        Set objSeq = objArgs.Item(objArgs.Count - 1)
        CheckListOrVec objSeq
 
        For i = 0 To objSeq.Count - 1
                objAST.Add objSeq.Item(i)
        Next
        
        Set varRes = objFn.ApplyWithoutEval(objAST, objEnv)
        Set MApply = varRes
End Function
objNS.Add NewMalSym("apply"), NewVbsProc("MApply", False)
 
Function MMap(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 2
        Dim objFn, objSeq
        Set objFn = objArgs.Item(1)
        Set objSeq = objArgs.Item(2)
        CheckType objFn, TYPES.PROCEDURE
        CheckListOrVec objSeq
        If objFn.IsSpecial Or objFn.IsMacro Then
                Err.Raise vbObjectError, _
                        "MApply", "Need a function."
        End If
 
        Set varRes = NewMalList(Array())
        Dim i
        For i = 0 To objSeq.Count - 1
                varRes.Add objFn.ApplyWithoutEval(NewMalList(Array( _
                        objFn, objSeq.Item(i))), objEnv)
        Next
 
        Set MMap = varRes
End Function
objNS.Add NewMalSym("map"), NewVbsProc("MMap", False)
 
Function MIsSymbol(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.SYMBOL)
        Set MIsSymbol = varRes
End Function
objNS.Add NewMalSym("symbol?"), NewVbsProc("MIsSymbol", False)
 
Function MSymbol(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        CheckType objArgs.Item(1), TYPES.STRING
        Set varRes = NewMalSym(objArgs.Item(1).Value)
        Set MSymbol = varRes
End Function
objNS.Add NewMalSym("symbol"), NewVbsProc("MSymbol", False)
 
Function MKeyword(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        Select Case objArgs.Item(1).Type
                Case TYPES.STRING
                        Set varRes = NewMalKwd(":" + objArgs.Item(1).Value)
                Case TYPES.KEYWORD
                        Set varRes = objArgs.Item(1)
                Case Else
                        Err.Raise vbObjectError, _
                                "MKeyword", "Unexpect argument(s)."
        End Select
        Set MKeyword = varRes
End Function
objNS.Add NewMalSym("keyword"), NewVbsProc("MKeyword", False)
 
Function MIsKeyword(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.KEYWORD)
        Set MIsKeyword = varRes
End Function
objNS.Add NewMalSym("keyword?"), NewVbsProc("MIsKeyword", False)
 
Function MIsSeq(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        Set varRes = NewMalBool( _
                objArgs.Item(1).Type = TYPES.LIST Or _
                objArgs.Item(1).Type = TYPES.VECTOR)
        Set MIsSeq = varRes
End Function
objNS.Add NewMalSym("sequential?"), NewVbsProc("MIsSeq", False)
 
Function MIsVec(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.VECTOR)
        Set MIsVec = varRes
End Function
objNS.Add NewMalSym("vector?"), NewVbsProc("MIsVec", False)
 
Function MIsMap(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.HASHMAP)
        Set MIsMap = varRes
End Function
objNS.Add NewMalSym("map?"), NewVbsProc("MIsMap", False)
 
Function MHashMap(objArgs, objEnv)
        Dim varRes
        If objArgs.Count Mod 2 <> 1 Then
                Err.Raise vbObjectError, _
                        "MHashMap", "Unexpect argument(s)."
        End If
        Set varRes = NewMalMap(Array(), Array())
        Dim i
        For i = 1 To objArgs.Count - 1 Step 2
                varRes.Add objArgs.Item(i), objArgs.Item(i + 1)
        Next
        Set MHashMap = varRes
End Function
objNS.Add NewMalSym("hash-map"), NewVbsProc("MHashMap", False)
 
Function MAssoc(objArgs, objEnv)
        Dim varRes
        If objArgs.Count - 1 < 3 Or objArgs.Count Mod 2 <> 0 Then
                Err.Raise vbObjectError, _
                        "MHashMap", "Unexpect argument(s)."
        End If
        
        Dim objMap
        Set objMap = objArgs.Item(1)
        CheckType objMap, TYPES.HASHMAP
 
        Dim i
        Set varRes = NewMalMap(Array(), Array())
        For Each i In objMap.Keys
                varRes.Add i, objMap.Item(i)
        Next
        For i = 2 To objArgs.Count - 1 Step 2
                varRes.Add objArgs.Item(i), objArgs.Item(i + 1)
        Next
        Set MAssoc = varRes
End Function
objNS.Add NewMalSym("assoc"), NewVbsProc("MAssoc", False)
 
Function MGet(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 2
        
        If objArgs.Item(1).Type = TYPES.NIL Then
                Set varRes = NewMalNil()
        Else
                CheckType objArgs.Item(1), TYPES.HASHMAP
                If objArgs.Item(1).Exists(objArgs.Item(2)) Then
                        Set varRes = objArgs.Item(1).Item(objArgs.Item(2))
                Else
                        Set varRes = NewMalNil()
                End If
        End If
        
        Set MGet = varRes
End Function
objNS.Add NewMalSym("get"), NewVbsProc("MGet", False)
 
Function MDissoc(objArgs, objEnv)
        Dim varRes
        'CheckArgNum objArgs, 2
        CheckType objArgs.Item(1), TYPES.HASHMAP
        
        If objArgs.Item(1).Exists(objArgs.Item(2)) Then
                Set varRes = NewMalMap(Array(), Array())
                
                Dim i
                Dim j, boolFlag
                For Each i In objArgs.Item(1).Keys
                        boolFlag = True
                        For j = 2 To objArgs.Count - 1
                                If i.Type = objArgs.Item(j).Type And _
                                        i.Value = objArgs.Item(j).Value Then
                                        boolFlag = False
                                End If
                        Next
                        If boolFlag Then
                                varRes.Add i, objArgs.Item(1).Item(i)
                        End If
                Next
        Else
                Set varRes = objArgs.Item(1)
        End If
 
        Set MDissoc = varRes
End Function
objNS.Add NewMalSym("dissoc"), NewVbsProc("MDissoc", False)
 
Function MKeys(objArgs, objEnv)
        CheckArgNum objArgs, 1
        CheckType objArgs.Item(1), TYPES.HASHMAP
        Set MKeys = NewMalList(objArgs.Item(1).Keys)
End Function
objNS.Add NewMalSym("keys"), NewVbsProc("MKeys", False)
 
Function MIsContains(objArgs, objEnv)
        CheckArgNum objArgs, 2
        CheckType objArgs.Item(1), TYPES.HASHMAP
 
        Set MIsContains = NewMalBool(objArgs.Item(1).Exists(objArgs.Item(2)))
End Function
objNS.Add NewMalSym("contains?"), NewVbsProc("MIsContains", False)
 
Function MReadLine(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        CheckType objArgs.Item(1), TYPES.STRING
 
        Dim strInput
        WScript.StdOut.Write objArgs.Item(1).Value
        On Error Resume Next
                strInput = WScript.StdIn.ReadLine()
                If Err.Number <> 0 Then
                        Set varRes = NewMalNil()
                Else
                        Set varRes = NewMalStr(strInput)
                End If
        On Error Goto 0
        Set MReadLine = varRes
End Function
objNS.Add NewMalSym("readline"), NewVbsProc("MReadLine", False)
 
Function MTimeMs(objArgs, objEnv)
        Set MTimeMs = NewMalNum(CLng(Timer * 1000))
End Function
objNS.Add NewMalSym("time-ms"), NewVbsProc("MTimeMs", False)
 
Function MIsStr(objArgs, objEnv)
        CheckArgNum objArgs, 1
        Set MIsStr = NewMalBool(objArgs.Item(1).Type = TYPES.STRING)
End Function
objNS.Add NewMalSym("string?"), NewVbsProc("MIsStr", False)
 
Function MIsNum(objArgs, objEnv)
        CheckArgNum objArgs, 1
        Set MIsNum = NewMalBool(objArgs.Item(1).Type = TYPES.NUMBER)
End Function
objNS.Add NewMalSym("number?"), NewVbsProc("MIsNum", False)
 
Function MIsFn(objArgs, objEnv)
        CheckArgNum objArgs, 1
        Dim varRes
        varRes = objArgs.Item(1).Type = TYPES.PROCEDURE
        If varRes Then
                varRes = (Not objArgs.Item(1).IsMacro) And _
                        (Not objArgs.Item(1).IsSpecial)
        End If
        
        Set MIsFn = NewMalBool(varRes)
End Function
objNS.Add NewMalSym("fn?"), NewVbsProc("MIsFn", False)
 
 
Function MIsMacro(objArgs, objEnv)
        CheckArgNum objArgs, 1
        Dim varRes
        varRes = objArgs.Item(1).Type = TYPES.PROCEDURE
        If varRes Then
                varRes = objArgs.Item(1).IsMacro And _
                        (Not objArgs.Item(1).IsSpecial)
        End If
        
        Set MIsMacro = NewMalBool(varRes)
End Function
objNS.Add NewMalSym("macro?"), NewVbsProc("MIsMacro", False)
 
 
Function MMeta(objArgs, objEnv)
        CheckArgNum objArgs, 1
        'CheckType objArgs.Item(1), TYPES.PROCEDURE
 
        Dim varRes
        Set varRes = GetMeta(objArgs.Item(1))
        Set MMeta = varRes
End Function
objNS.Add NewMalSym("meta"), NewVbsProc("MMeta", False)
 
Function MWithMeta(objArgs, objEnv)
        CheckArgNum objArgs, 2
        'CheckType objArgs.Item(1), TYPES.PROCEDURE
 
        Dim varRes
        Set varRes = SetMeta(objArgs.Item(1), objArgs.Item(2))
        Set MWithMeta = varRes
End Function
objNS.Add NewMalSym("with-meta"), NewVbsProc("MWithMeta", False)
 
Function MConj(objArgs, objEnv)
        If objArgs.Count - 1 < 1 Then
                Err.Raise vbObjectError, _
                        "MConj", "Need more arguments."
        End If
        Dim varRes
        Dim objSeq
        Set objSeq = objArgs.Item(1)
        Dim i
        Select Case objSeq.Type
                Case TYPES.LIST
                        Set varRes = NewMalList(Array())
                        For i = objArgs.Count - 1 To 2 Step -1
                                varRes.Add objArgs.Item(i)
                        Next
                        For i = 0 To objSeq.Count - 1
                                varRes.Add objSeq.Item(i)
                        Next
                Case TYPES.VECTOR
                        Set varRes = NewMalVec(Array())
                        For i = 0 To objSeq.Count - 1
                                varRes.Add objSeq.Item(i)
                        Next
                        For i = 2 To objArgs.Count - 1
                                varRes.Add objArgs.Item(i)
                        Next
                Case Else        
                        Err.Raise vbObjectError, _
                                "MConj", "Unexpect argument type."
        End Select
        Set MConj = varRes
End Function
objNS.Add NewMalSym("conj"), NewVbsProc("MConj", False)
 
Function MSeq(objArgs, objEnv)
        CheckArgNum objArgs, 1
        Dim objSeq
        Set objSeq = objArgs.Item(1)
        Dim varRes
        Dim i
        Select Case objSeq.Type
                Case TYPES.STRING
                        If objSeq.Value = "" Then
                                Set varRes = NewMalNil()
                        Else
                                Set varRes = NewMalList(Array())
                                For i = 1 To Len(objSeq.Value)
                                        varRes.Add NewMalStr(Mid(objSeq.Value, i, 1))
                                Next
                        End If
                Case TYPES.LIST
                        If objSeq.Count = 0 Then
                                Set varRes = NewMalNil()
                        Else
                                Set varRes = objSeq
                        End If
                Case TYPES.VECTOR
                        If objSeq.Count = 0 Then
                                Set varRes = NewMalNil()
                        Else
                                Set varRes = NewMalList(Array())
                                For i = 0 To objSeq.Count - 1
                                        varRes.Add objSeq.Item(i)
                                Next
                        End If
                Case TYPES.NIL
                        Set varRes = NewMalNil()
                Case Else
                        Err.Raise vbObjectError, _
                                "MSeq", "Unexpect argument type."
        End Select
        Set MSeq = varRes
End Function
objNS.Add NewMalSym("seq"), NewVbsProc("MSeq", False)
 
 
Class TailCall
        Public objMalType
        Public objEnv
End Class
 
Function EvalLater(objMal, objEnv)
        Dim varRes
        Set varRes = New TailCall
        Set varRes.objMalType = objMal
        Set varRes.objEnv = objEnv
        Set EvalLater = varRes
End Function
 
Function MDef(objArgs, objEnv)
        Dim varRet
        CheckArgNum objArgs, 2
        CheckType objArgs.Item(1), TYPES.SYMBOL
        Set varRet = Evaluate(objArgs.Item(2), objEnv)
        objEnv.Add objArgs.Item(1), varRet
        Set MDef = varRet
End Function
objNS.Add NewMalSym("def!"), NewVbsProc("MDef", True)
 
Function MLet(objArgs, objEnv)
        Dim varRet
        CheckArgNum objArgs, 2
 
        Dim objBinds
        Set objBinds = objArgs.Item(1)
        CheckListOrVec objBinds
        
        If objBinds.Count Mod 2 <> 0 Then
                Err.Raise vbObjectError, _
                        "MLet", "Wrong argument count."
        End If
 
        Dim objNewEnv
        Set objNewEnv = NewEnv(objEnv)
        Dim i, objSym
        For i = 0 To objBinds.Count - 1 Step 2
                Set objSym = objBinds.Item(i)
                CheckType objSym, TYPES.SYMBOL
                objNewEnv.Add objSym, Evaluate(objBinds.Item(i + 1), objNewEnv)
        Next
 
        Set varRet = EvalLater(objArgs.Item(2), objNewEnv)
        Set MLet = varRet
End Function
objNS.Add NewMalSym("let*"), NewVbsProc("MLet", True)
 
Function MDo(objArgs, objEnv)
        Dim varRet, i
        If objArgs.Count - 1 < 1 Then
                Err.Raise vbObjectError, _
                        "MDo", "Need more arguments."
        End If
        For i = 1 To objArgs.Count - 2
                Call Evaluate(objArgs.Item(i), objEnv)
        Next
        Set varRet = EvalLater( _
                objArgs.Item(objArgs.Count - 1), _
                objEnv)
        Set MDo = varRet
End Function
objNS.Add NewMalSym("do"), NewVbsProc("MDo", True)
 
Function MIf(objArgs, objEnv)
        Dim varRet
        If objArgs.Count - 1 <> 3 And _
                objArgs.Count - 1 <> 2 Then
                Err.Raise vbObjectError, _
                        "MIf", "Wrong number of arguments."
        End If
 
        Dim objCond
        Set objCond = Evaluate(objArgs.Item(1), objEnv)
        Dim boolCond
        If objCond.Type = TYPES.BOOLEAN Then
                boolCond = objCond.Value
        Else
                boolCond = True
        End If
        boolCond = (boolCond And objCond.Type <> TYPES.NIL)
        If boolCond Then
                Set varRet = EvalLater(objArgs.Item(2), objEnv)
        Else
                If objArgs.Count - 1 = 3 Then
                        Set varRet = EvalLater(objArgs.Item(3), objEnv)
                Else
                        Set varRet = NewMalNil()
                End If
        End If
        Set MIf = varRet
End Function
objNS.Add NewMalSym("if"), NewVbsProc("MIf", True)
 
Function MFn(objArgs, objEnv)
        Dim varRet
        CheckArgNum objArgs, 2
 
        Dim objParams, objCode
        Set objParams = objArgs.Item(1)
        CheckListOrVec objParams
        Set objCode = objArgs.Item(2)
        
        Dim i
        For i = 0 To objParams.Count - 1
                CheckType objParams.Item(i), TYPES.SYMBOL
        Next
        Set varRet = NewMalProc(objParams, objCode, objEnv)
        Set MFn = varRet
End Function
objNS.Add NewMalSym("fn*"), NewVbsProc("MFn", True)
 
Function MEval(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
 
        Set varRes = Evaluate(objArgs.Item(1), objEnv)
        Set varRes = EvalLater(varRes, objNS)
        Set MEval = varRes
End Function
objNS.Add NewMalSym("eval"), NewVbsProc("MEval", True)
 
Function MQuote(objArgs, objEnv)
        CheckArgNum objArgs, 1
        Set MQuote = objArgs.Item(1)
End Function
objNS.Add NewMalSym("quote"), NewVbsProc("MQuote", True)
 
Function MQuasiQuote(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        
        Set varRes = EvalLater( _
                MQuasiQuoteExpand(objArgs, objEnv), objEnv)
        Set MQuasiQuote = varRes
End Function
objNS.Add NewMalSym("quasiquote"), NewVbsProc("MQuasiQuote", True)
 
Function MQuasiQuoteExpand(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
 
        Set varRes = ExpandHelper(objArgs.Item(1))
        If varRes.Splice Then
                Err.Raise vbObjectError, _
                        "MQuasiQuoteExpand", "Wrong return value type."
        End If
        Set varRes = varRes.Value
 
        Set MQuasiQuoteExpand = varRes
End Function
objNS.Add NewMalSym("quasiquoteexpand"), NewVbsProc("MQuasiQuoteExpand", True)
 
Class ExpandType
        Public Splice
        Public Value
End Class
 
Function NewExpandType(objValue, boolSplice)
        Dim varRes
        Set varRes = New ExpandType
        Set varRes.Value = objValue
        varRes.Splice = boolSplice
        Set NewExpandType = varRes
End Function
 
Function ExpandHelper(objArg)
        Dim varRes, boolSplice
        Dim varBuilder, varEType, i
        boolSplice = False
        Select Case objArg.Type
                Case TYPES.LIST
                        Dim boolNormal
                        boolNormal = False
 
                        ' Check for unquotes.
                        Select Case objArg.Count
                                Case 2
                                        ' Maybe have a bug here
                                        ' like (unquote a b c) should be throw a error
                                        If objArg.Item(0).Type = TYPES.SYMBOL Then
                                                Select Case objArg.Item(0).Value
                                                        Case "unquote"
                                                                Set varRes = objArg.Item(1)
                                                        Case "splice-unquote"
                                                                Set varRes = objArg.Item(1)
                                                                boolSplice = True
                                                        Case Else
                                                                boolNormal = True
                                                End Select
                                        Else
                                                boolNormal = True
                                        End If
                                Case Else
                                        boolNormal = True
                        End Select
                        
                        If boolNormal Then
                                Set varRes = NewMalList(Array())
                                Set varBuilder = varRes
 
                                For i = 0 To objArg.Count - 1
                                        Set varEType = ExpandHelper(objArg.Item(i))
                                        If varEType.Splice Then
                                                varBuilder.Add NewMalSym("concat")
                                        Else
                                                varBuilder.Add NewMalSym("cons")
                                        End If
                                        varBuilder.Add varEType.Value
                                        varBuilder.Add NewMalList(Array())
                                        Set varBuilder = varBuilder.Item(2)
                                Next
                        End If
                Case TYPES.VECTOR
                        Set varRes = NewMalList(Array( _
                                NewMalSym("vec"), NewMalList(Array())))
                        
                        Set varBuilder = varRes.Item(1)
                        For i = 0 To objArg.Count - 1
                                Set varEType = ExpandHelper(objArg.Item(i))
                                If varEType.Splice Then
                                        varBuilder.Add NewMalSym("concat")
                                Else
                                        varBuilder.Add NewMalSym("cons")
                                End If
                                varBuilder.Add varEType.Value
                                varBuilder.Add NewMalList(Array())
                                Set varBuilder = varBuilder.Item(2)
                        Next
                Case TYPES.HASHMAP
                        ' Maybe have a bug here.
                        ' e.g. {"key" ~value}
                        Set varRes = NewMalList(Array( _
                                NewMalSym("quote"), objArg))
                Case TYPES.SYMBOL
                        Set varRes = NewMalList(Array( _
                                NewMalSym("quote"), objArg))
                Case Else
                        ' Maybe have a bug here.
                        ' All unspecified type will return itself.
                        Set varRes = objArg
        End Select
 
        Set ExpandHelper = NewExpandType(varRes, boolSplice)
End Function
 
Function MDefMacro(objArgs, objEnv)
        Dim varRet
        CheckArgNum objArgs, 2
        CheckType objArgs.Item(1), TYPES.SYMBOL
        Set varRet = Evaluate(objArgs.Item(2), objEnv).Copy()
        CheckType varRet, TYPES.PROCEDURE
        varRet.IsMacro = True
        objEnv.Add objArgs.Item(1), varRet
        Set MDefMacro = varRet
End Function
objNS.Add NewMalSym("defmacro!"), NewVbsProc("MDefMacro", True)
 
Function IsMacroCall(objCode, objEnv)
        Dim varRes
        varRes = False
 
        ' VBS has no short-circuit evaluation.
        If objCode.Type = TYPES.LIST Then
                If objCode.Count > 0 Then
                        If objCode.Item(0).Type = TYPES.SYMBOL Then
                                Dim varValue
                                Set varValue = objEnv.Get(objCode.Item(0))
                                If varValue.Type = TYPES.PROCEDURE Then
                                        If varValue.IsMacro Then
                                                varRes = True
                                        End If
                                End If
                        End If
                End If
        End If
 
        IsMacroCall = varRes
End Function
 
Function MacroExpand(ByVal objAST, ByVal objEnv)
        Dim varRes
        While IsMacroCall(objAST, objEnv)
                Dim varMacro
                Set varMacro = objEnv.Get(objAST.Item(0))
                Set objAST = varMacro.MacroApply(objAST, objEnv)                
        Wend
        Set varRes = objAST
        Set MacroExpand = varRes
End Function
 
Function MMacroExpand(objArgs, objEnv)
        Dim varRes
        CheckArgNum objArgs, 1
        Set varRes = MacroExpand(objArgs.Item(1), objEnv)
        Set MMacroExpand = varRes
End Function
objNS.Add NewMalSym("macroexpand"), NewVbsProc("MMacroExpand", True)
 
Function MTry(objArgs, objEnv)
        Dim varRes
        
        If objArgs.Count - 1 < 1 Then
                Err.Raise vbObjectError, _
                        "MTry", "Need more arguments."
        End If
 
        If objArgs.Count - 1 = 1 Then
                Set varRes = EvalLater(objArgs.Item(1), objEnv)
                Set MTry = varRes
                Exit Function
        End If
 
        CheckArgNum objArgs, 2
        CheckType objArgs.Item(2), TYPES.LIST
 
        Dim objTry, objCatch
        Set objTry = objArgs.Item(1)
        Set objCatch = objArgs.Item(2)
        
        CheckArgNum objCatch, 2
        CheckType objCatch.Item(0), TYPES.SYMBOL
        CheckType objCatch.Item(1), TYPES.SYMBOL
        If objCatch.Item(0).Value <> "catch*" Then
                Err.Raise vbObjectError, _
                        "MTry", "Unexpect argument(s)."
        End If
        
        On Error Resume Next
        Set varRes = Evaluate(objTry, objEnv)
        If Err.Number <> 0 Then
                Dim objException
 
                If Err.Source <> "MThrow" Then
                        Set objException = NewMalStr(Err.Description)
                Else
                        Set objException = objExceptions.Item(Err.Description)
                        objExceptions.Remove Err.Description
                End If
                
                Call Err.Clear()
                On Error Goto 0
 
                ' The code below may cause error too.
                ' So we should clear err info & throw out any errors.
                ' Use 'quote' to avoid eval objExp again.
                Set varRes = Evaluate(NewMalList(Array( _
                        NewMalSym("let*"), NewMalList(Array( _
                                objCatch.Item(1), NewMalList(Array( _
                                                NewMalSym("quote"), objException)))), _
                        objCatch.Item(2))), objEnv)
        Else
                On Error Goto 0
        End If
 
        Set MTry = varRes
End Function
objNS.Add NewMalSym("try*"), NewVbsProc("MTry", True)
 
Call InitBuiltIn()
Call InitMacro()
 
Call InitArgs()
Sub InitArgs()
        Dim objArgs
        Set objArgs = NewMalList(Array())
 
        Dim i
        For i = 1 To WScript.Arguments.Count - 1
                objArgs.Add NewMalStr(WScript.Arguments.Item(i))
        Next
        
        objNS.Add NewMalSym("*ARGV*"), objArgs
        
        If WScript.Arguments.Count > 0 Then
                REP "(load-file """ + WScript.Arguments.Item(0) + """)"
                WScript.Quit 0
        End If
End Sub
 
Randomize 1228
Call REPL()
Sub REPL()
        Dim strCode, strResult
        REP "(println (str ""Mal [""*host-language*""]""))"
        While True
                WScript.StdOut.Write "user> "
 
                On Error Resume Next
                        strCode = WScript.StdIn.ReadLine()
                        If Err.Number <> 0 Then WScript.Quit 0
                On Error Goto 0
                
                Dim strRes
                On Error Resume Next
                        strRes = REP(strCode)
                        If Err.Number <> 0 Then
                                If Err.Source = "MThrow" Then
                                        'WScript.StdErr.WriteLine Err.Source + ": " + _
                                        WScript.StdErr.WriteLine "Exception: " + _
                                                PrintMalType(objExceptions.Item(Err.Description), True)
                                        objExceptions.Remove Err.Description
                                Else
                                        'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description
                                        WScript.StdErr.WriteLine "Exception: " + Err.Description
                                End If
                        Else
                                If strRes <> "" Then
                                        WScript.Echo strRes
                                End If
                        End If
                On Error Goto 0
        Wend
End Sub
 
Function Read(strCode)
        Set Read = ReadString(strCode)
End Function
 
Function Evaluate(ByVal objCode, ByVal objEnv)
        While True
                If TypeName(objCode) = "Nothing" Then
                        Set Evaluate = Nothing
                        Exit Function
                End If
                
                Set objCode = MacroExpand(objCode, objEnv)
 
                Dim varRet, objFirst
                If objCode.Type = TYPES.LIST Then
                        If objCode.Count = 0 Then ' ()
                                Set Evaluate = objCode
                                Exit Function
                        End If
 
                        Set objFirst = Evaluate(objCode.Item(0), objEnv)
                        Set varRet = objFirst.Apply(objCode, objEnv)
                Else
                        Set varRet = EvaluateAST(objCode, objEnv)
                End If
                
                If TypeName(varRet) = "TailCall" Then
                        ' NOTICE: If not specify 'ByVal', 
                        ' Change of arguments will influence
                        ' the caller's variable!
                        Set objCode = varRet.objMalType
                        Set objEnv = varRet.objEnv
                Else
                        Set Evaluate = varRet
                        Exit Function
                End If
        Wend
End Function
 
 
Function EvaluateAST(objCode, objEnv)
        Dim varRet, i
        Select Case objCode.Type
                Case TYPES.SYMBOL
                        Set varRet = objEnv.Get(objCode)
                Case TYPES.LIST
                        Err.Raise vbObjectError, _
                                "EvaluateAST", "Unexpect type."
                Case TYPES.VECTOR
                        Set varRet = NewMalVec(Array())
                        For i = 0 To objCode.Count() - 1
                                varRet.Add Evaluate(objCode.Item(i), objEnv)
                        Next
                Case TYPES.HASHMAP
                        Set varRet = NewMalMap(Array(), Array())
                        For Each i In objCode.Keys()
                                varRet.Add i, Evaluate(objCode.Item(i), objEnv)
                        Next
                Case Else
                        Set varRet = objCode
        End Select
        Set EvaluateAST = varRet
End Function
 
Function EvaluateRest(objCode, objEnv)
        Dim varRet, i
        Select Case objCode.Type
                Case TYPES.LIST
                        Set varRet = NewMalList(Array(NewMalNil()))
                        For i = 1 To objCode.Count() - 1
                                varRet.Add Evaluate(objCode.Item(i), objEnv)
                        Next
                Case Else
                        Err.Raise vbObjectError, _
                                "EvaluateRest", "Unexpected type."
        End Select
        Set EvaluateRest = varRet
End Function
 
Function Print(objCode)
        Print = PrintMalType(objCode, True)
End Function
 
Function REP(strCode)
        REP = Print(Evaluate(Read(strCode), objNS))
End Function
 
Sub Include(strFileName)
        With CreateObject("Scripting.FileSystemObject")
                ExecuteGlobal .OpenTextFile( _
                        .GetParentFolderName( _
                        .GetFile(WScript.ScriptFullName)) & _
                        "\" & strFileName).ReadAll
        End With
End SubCOPY