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

老刘1号

项目描述

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

项目职责

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

遇到的实际问题及解决思路
问题1：解释器要求实现闭包、但 VBScript 语言本身不支持闭包。

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

问题2：需要实现尾递归优化。

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

问题3：在封装 MAL 的各种数据类型中需要对统一接口做出抽象。

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

问题4：批处理对字符串封装不足、处理困难。

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

问题5：批处理难以对复杂逻辑进行抽象。

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

印象深刻的 BUGs

• 由于 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 Sub
复制代码

czjt1234

不明觉厉                                           .

老刘1号

几个测试用例（相等于语法教程了）

;; Testing evaluation of arithmetic operations
(+ 1 2)
;=>3

(+ 5 (* 2 3))
;=>11

(- (+ 5 (* 2 3)) 3)
;=>8

(/ (- (+ 5 (* 2 3)) 3) 4)
;=>2

(/ (- (+ 515 (* 87 311)) 302) 27)
;=>1010

(* -3 6)
;=>-18

(/ (- (+ 515 (* -87 311)) 296) 27)
;=>-994

;;; This should throw an error with no return value
(abc 1 2 3)
;/.+

;; Testing empty list
()
;=>()

;>>> deferrable=True
;;
;; -------- Deferrable Functionality --------

;; Testing evaluation within collection literals
[1 2 (+ 1 2)]
;=>[1 2 3]

{"a" (+ 7 8)}
;=>{"a" 15}

{:a (+ 7 8)}
;=>{:a 15}

;; Check that evaluation hasn't broken empty collections
[]
;=>[]
{}
;=>{}
复制代码

;; Testing REPL_ENV
(+ 1 2)
;=>3
(/ (- (+ 5 (* 2 3)) 3) 4)
;=>2


;; Testing def!
(def! x 3)
;=>3
x
;=>3
(def! x 4)
;=>4
x
;=>4
(def! y (+ 1 7))
;=>8
y
;=>8

;; Verifying symbols are case-sensitive
(def! mynum 111)
;=>111
(def! MYNUM 222)
;=>222
mynum
;=>111
MYNUM
;=>222

;; Check env lookup non-fatal error
(abc 1 2 3)
;/.*\'?abc\'? not found.*
;; Check that error aborts def!
(def! w 123)
(def! w (abc))
w
;=>123

;; Testing let*
(let* (z 9) z)
;=>9
(let* (x 9) x)
;=>9
x
;=>4
(let* (z (+ 2 3)) (+ 1 z))
;=>6
(let* (p (+ 2 3) q (+ 2 p)) (+ p q))
;=>12
(def! y (let* (z 7) z))
y
;=>7

;; Testing outer environment
(def! a 4)
;=>4
(let* (q 9) q)
;=>9
(let* (q 9) a)
;=>4
(let* (z 2) (let* (q 9) a))
;=>4

;>>> deferrable=True
;;
;; -------- Deferrable Functionality --------

;; Testing let* with vector bindings
(let* [z 9] z)
;=>9
(let* [p (+ 2 3) q (+ 2 p)] (+ p q))
;=>12

;; Testing vector evaluation
(let* (a 5 b 6) [3 4 a [b 7] 8])
;=>[3 4 5 [6 7] 8]

;>>> soft=True
;>>> optional=True
;;
;; -------- Optional Functionality --------

;; Check that last assignment takes priority
(let* (x 2 x 3) x)
;=>3
复制代码

;; -----------------------------------------------------


;; Testing list functions
(list)
;=>()
(list? (list))
;=>true
(empty? (list))
;=>true
(empty? (list 1))
;=>false
(list 1 2 3)
;=>(1 2 3)
(count (list 1 2 3))
;=>3
(count (list))
;=>0
(count nil)
;=>0
(if (> (count (list 1 2 3)) 3) 89 78)
;=>78
(if (>= (count (list 1 2 3)) 3) 89 78)
;=>89


;; Testing if form
(if true 7 8)
;=>7
(if false 7 8)
;=>8
(if false 7 false)
;=>false
(if true (+ 1 7) (+ 1 8))
;=>8
(if false (+ 1 7) (+ 1 8))
;=>9
(if nil 7 8)
;=>8
(if 0 7 8)
;=>7
(if (list) 7 8)
;=>7
(if (list 1 2 3) 7 8)
;=>7
(= (list) nil)
;=>false


;; Testing 1-way if form
(if false (+ 1 7))
;=>nil
(if nil 8)
;=>nil
(if nil 8 7)
;=>7
(if true (+ 1 7))
;=>8


;; Testing basic conditionals
(= 2 1)
;=>false
(= 1 1)
;=>true
(= 1 2)
;=>false
(= 1 (+ 1 1))
;=>false
(= 2 (+ 1 1))
;=>true
(= nil 1)
;=>false
(= nil nil)
;=>true

(> 2 1)
;=>true
(> 1 1)
;=>false
(> 1 2)
;=>false

(>= 2 1)
;=>true
(>= 1 1)
;=>true
(>= 1 2)
;=>false

(< 2 1)
;=>false
(< 1 1)
;=>false
(< 1 2)
;=>true

(<= 2 1)
;=>false
(<= 1 1)
;=>true
(<= 1 2)
;=>true


;; Testing equality
(= 1 1)
;=>true
(= 0 0)
;=>true
(= 1 0)
;=>false
(= true true)
;=>true
(= false false)
;=>true
(= nil nil)
;=>true

(= (list) (list))
;=>true
(= (list) ())
;=>true
(= (list 1 2) (list 1 2))
;=>true
(= (list 1) (list))
;=>false
(= (list) (list 1))
;=>false
(= 0 (list))
;=>false
(= (list) 0)
;=>false
(= (list nil) (list))
;=>false


;; Testing builtin and user defined functions
(+ 1 2)
;=>3
( (fn* (a b) (+ b a)) 3 4)
;=>7
( (fn* () 4) )
;=>4

( (fn* (f x) (f x)) (fn* (a) (+ 1 a)) 7)
;=>8


;; Testing closures
( ( (fn* (a) (fn* (b) (+ a b))) 5) 7)
;=>12

(def! gen-plus5 (fn* () (fn* (b) (+ 5 b))))
(def! plus5 (gen-plus5))
(plus5 7)
;=>12

(def! gen-plusX (fn* (x) (fn* (b) (+ x b))))
(def! plus7 (gen-plusX 7))
(plus7 8)
;=>15

;; Testing do form
(do (prn 101))
;/101
;=>nil
(do (prn 102) 7)
;/102
;=>7
(do (prn 101) (prn 102) (+ 1 2))
;/101
;/102
;=>3

(do (def! a 6) 7 (+ a 8))
;=>14
a
;=>6

;; Testing special form case-sensitivity
(def! DO (fn* (a) 7))
(DO 3)
;=>7

;; Testing recursive sumdown function
(def! sumdown (fn* (N) (if (> N 0) (+ N (sumdown  (- N 1))) 0)))
(sumdown 1)
;=>1
(sumdown 2)
;=>3
(sumdown 6)
;=>21


;; Testing recursive fibonacci function
(def! fib (fn* (N) (if (= N 0) 1 (if (= N 1) 1 (+ (fib (- N 1)) (fib (- N 2)))))))
(fib 1)
;=>1
(fib 2)
;=>2
(fib 4)
;=>5


;; Testing recursive function in environment.
(let* (f (fn* () x) x 3) (f))
;=>3
(let* (cst (fn* (n) (if (= n 0) nil (cst (- n 1))))) (cst 1))
;=>nil
(let* (f (fn* (n) (if (= n 0) 0 (g (- n 1)))) g (fn* (n) (f n))) (f 2))
;=>0


;>>> deferrable=True
;;
;; -------- Deferrable Functionality --------

;; Testing if on strings

(if "" 7 8)
;=>7

;; Testing string equality

(= "" "")
;=>true
(= "abc" "abc")
;=>true
(= "abc" "")
;=>false
(= "" "abc")
;=>false
(= "abc" "def")
;=>false
(= "abc" "ABC")
;=>false
(= (list) "")
;=>false
(= "" (list))
;=>false

;; Testing variable length arguments

( (fn* (& more) (count more)) 1 2 3)
;=>3
( (fn* (& more) (list? more)) 1 2 3)
;=>true
( (fn* (& more) (count more)) 1)
;=>1
( (fn* (& more) (count more)) )
;=>0
( (fn* (& more) (list? more)) )
;=>true
( (fn* (a & more) (count more)) 1 2 3)
;=>2
( (fn* (a & more) (count more)) 1)
;=>0
( (fn* (a & more) (list? more)) 1)
;=>true


;; Testing language defined not function
(not false)
;=>true
(not nil)
;=>true
(not true)
;=>false
(not "a")
;=>false
(not 0)
;=>false


;; -----------------------------------------------------

;; Testing string quoting

""
;=>""

"abc"
;=>"abc"

"abc  def"
;=>"abc  def"

"\""
;=>"\""

"abc\ndef\nghi"
;=>"abc\ndef\nghi"

"abc\\def\\ghi"
;=>"abc\\def\\ghi"

"\\n"
;=>"\\n"

;; Testing pr-str

(pr-str)
;=>""

(pr-str "")
;=>"\"\""

(pr-str "abc")
;=>"\"abc\""

(pr-str "abc  def" "ghi jkl")
;=>"\"abc  def\" \"ghi jkl\""

(pr-str "\"")
;=>"\"\\\"\""

(pr-str (list 1 2 "abc" "\"") "def")
;=>"(1 2 \"abc\" \"\\\"\") \"def\""

(pr-str "abc\ndef\nghi")
;=>"\"abc\\ndef\\nghi\""

(pr-str "abc\\def\\ghi")
;=>"\"abc\\\\def\\\\ghi\""

(pr-str (list))
;=>"()"

;; Testing str

(str)
;=>""

(str "")
;=>""

(str "abc")
;=>"abc"

(str "\"")
;=>"\""

(str 1 "abc" 3)
;=>"1abc3"

(str "abc  def" "ghi jkl")
;=>"abc  defghi jkl"

(str "abc\ndef\nghi")
;=>"abc\ndef\nghi"

(str "abc\\def\\ghi")
;=>"abc\\def\\ghi"

(str (list 1 2 "abc" "\"") "def")
;=>"(1 2 abc \")def"

(str (list))
;=>"()"

;; Testing prn
(prn)
;/
;=>nil

(prn "")
;/""
;=>nil

(prn "abc")
;/"abc"
;=>nil

(prn "abc  def" "ghi jkl")
;/"abc  def" "ghi jkl"

(prn "\"")
;/"\\""
;=>nil

(prn "abc\ndef\nghi")
;/"abc\\ndef\\nghi"
;=>nil

(prn "abc\\def\\ghi")
;/"abc\\\\def\\\\ghi"
nil

(prn (list 1 2 "abc" "\"") "def")
;/\(1 2 "abc" "\\""\) "def"
;=>nil


;; Testing println
(println)
;/
;=>nil

(println "")
;/
;=>nil

(println "abc")
;/abc
;=>nil

(println "abc  def" "ghi jkl")
;/abc  def ghi jkl

(println "\"")
;/"
;=>nil

(println "abc\ndef\nghi")
;/abc
;/def
;/ghi
;=>nil

(println "abc\\def\\ghi")
;/abc\\def\\ghi
;=>nil

(println (list 1 2 "abc" "\"") "def")
;/\(1 2 abc "\) def
;=>nil


;; Testing keywords
(= :abc :abc)
;=>true
(= :abc :def)
;=>false
(= :abc ":abc")
;=>false
(= (list :abc) (list :abc))
;=>true

;; Testing vector truthiness
(if [] 7 8)
;=>7

;; Testing vector printing
(pr-str [1 2 "abc" "\""] "def")
;=>"[1 2 \"abc\" \"\\\"\"] \"def\""

(pr-str [])
;=>"[]"

(str [1 2 "abc" "\""] "def")
;=>"[1 2 abc \"]def"

(str [])
;=>"[]"


;; Testing vector functions
(count [1 2 3])
;=>3
(empty? [1 2 3])
;=>false
(empty? [])
;=>true
(list? [4 5 6])
;=>false

;; Testing vector equality
(= [] (list))
;=>true
(= [7 8] [7 8])
;=>true
(= [:abc] [:abc])
;=>true
(= (list 1 2) [1 2])
;=>true
(= (list 1) [])
;=>false
(= [] [1])
;=>false
(= 0 [])
;=>false
(= [] 0)
;=>false
(= [] "")
;=>false
(= "" [])
;=>false

;; Testing vector parameter lists
( (fn* [] 4) )
;=>4
( (fn* [f x] (f x)) (fn* [a] (+ 1 a)) 7)
;=>8

;; Nested vector/list equality
(= [(list)] (list []))
;=>true
(= [1 2 (list 3 4 [5 6])] (list 1 2 [3 4 (list 5 6)]))
;=>true
复制代码

;; Testing cons function
(cons 1 (list))
;=>(1)
(cons 1 (list 2))
;=>(1 2)
(cons 1 (list 2 3))
;=>(1 2 3)
(cons (list 1) (list 2 3))
;=>((1) 2 3)

(def! a (list 2 3))
(cons 1 a)
;=>(1 2 3)
a
;=>(2 3)

;; Testing concat function
(concat)
;=>()
(concat (list 1 2))
;=>(1 2)
(concat (list 1 2) (list 3 4))
;=>(1 2 3 4)
(concat (list 1 2) (list 3 4) (list 5 6))
;=>(1 2 3 4 5 6)
(concat (concat))
;=>()
(concat (list) (list))
;=>()
(= () (concat))
;=>true

(def! a (list 1 2))
(def! b (list 3 4))
(concat a b (list 5 6))
;=>(1 2 3 4 5 6)
a
;=>(1 2)
b
;=>(3 4)

;; Testing regular quote
(quote 7)
;=>7
(quote (1 2 3))
;=>(1 2 3)
(quote (1 2 (3 4)))
;=>(1 2 (3 4))

;; Testing simple quasiquote
(quasiquote nil)
;=>nil
(quasiquote 7)
;=>7
(quasiquote a)
;=>a
(quasiquote {"a" b})
;=>{"a" b}

;; Testing quasiquote with lists
(quasiquote ())
;=>()
(quasiquote (1 2 3))
;=>(1 2 3)
(quasiquote (a))
;=>(a)
(quasiquote (1 2 (3 4)))
;=>(1 2 (3 4))
(quasiquote (nil))
;=>(nil)
(quasiquote (1 ()))
;=>(1 ())
(quasiquote (() 1))
;=>(() 1)
(quasiquote (1 () 2))
;=>(1 () 2)
(quasiquote (()))
;=>(())
;; (quasiquote (f () g (h) i (j k) l))
;; =>(f () g (h) i (j k) l)

;; Testing unquote
(quasiquote (unquote 7))
;=>7
(def! a 8)
;=>8
(quasiquote a)
;=>a
(quasiquote (unquote a))
;=>8
(quasiquote (1 a 3))
;=>(1 a 3)
(quasiquote (1 (unquote a) 3))
;=>(1 8 3)
(def! b (quote (1 "b" "d")))
;=>(1 "b" "d")
(quasiquote (1 b 3))
;=>(1 b 3)
(quasiquote (1 (unquote b) 3))
;=>(1 (1 "b" "d") 3)
(quasiquote ((unquote 1) (unquote 2)))
;=>(1 2)

;; Quasiquote and environments
(let* (x 0) (quasiquote (unquote x)))
;=>0

;; Testing splice-unquote
(def! c (quote (1 "b" "d")))
;=>(1 "b" "d")
(quasiquote (1 c 3))
;=>(1 c 3)
(quasiquote (1 (splice-unquote c) 3))
;=>(1 1 "b" "d" 3)
(quasiquote (1 (splice-unquote c)))
;=>(1 1 "b" "d")
(quasiquote ((splice-unquote c) 2))
;=>(1 "b" "d" 2)
(quasiquote ((splice-unquote c) (splice-unquote c)))
;=>(1 "b" "d" 1 "b" "d")

;; Testing symbol equality
(= (quote abc) (quote abc))
;=>true
(= (quote abc) (quote abcd))
;=>false
(= (quote abc) "abc")
;=>false
(= "abc" (quote abc))
;=>false
(= "abc" (str (quote abc)))
;=>true
(= (quote abc) nil)
;=>false
(= nil (quote abc))
;=>false

;>>> deferrable=True
;;
;; -------- Deferrable Functionality --------

;; Testing ' (quote) reader macro
'7
;=>7
'(1 2 3)
;=>(1 2 3)
'(1 2 (3 4))
;=>(1 2 (3 4))

;; Testing cons and concat with vectors

(cons 1 [])
;=>(1)
(cons [1] [2 3])
;=>([1] 2 3)
(cons 1 [2 3])
;=>(1 2 3)
(concat [1 2] (list 3 4) [5 6])
;=>(1 2 3 4 5 6)
(concat [1 2])
;=>(1 2)

;>>> optional=True
;;
;; -------- Optional Functionality --------

;; Testing ` (quasiquote) reader macro
`7
;=>7
`(1 2 3)
;=>(1 2 3)
`(1 2 (3 4))
;=>(1 2 (3 4))
`(nil)
;=>(nil)

;; Testing ~ (unquote) reader macro
`~7
;=>7
(def! a 8)
;=>8
`(1 ~a 3)
;=>(1 8 3)
(def! b '(1 "b" "d"))
;=>(1 "b" "d")
`(1 b 3)
;=>(1 b 3)
`(1 ~b 3)
;=>(1 (1 "b" "d") 3)

;; Testing ~@ (splice-unquote) reader macro
(def! c '(1 "b" "d"))
;=>(1 "b" "d")
`(1 c 3)
;=>(1 c 3)
`(1 ~@c 3)
;=>(1 1 "b" "d" 3)

;>>> soft=True

;; Testing vec function

(vec (list))
;=>[]
(vec (list 1))
;=>[1]
(vec (list 1 2))
;=>[1 2]
(vec [])
;=>[]
(vec [1 2])
;=>[1 2]

;; Testing that vec does not mutate the original list
(def! a (list 1 2))
(vec a)
;=>[1 2]
a
;=>(1 2)

;; Test quine
((fn* (q) (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* (q) (quasiquote ((unquote q) (quote (unquote q)))))))
;=>((fn* (q) (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* (q) (quasiquote ((unquote q) (quote (unquote q)))))))

;; Testing quasiquote with vectors
(quasiquote [])
;=>[]
(quasiquote [[]])
;=>[[]]
(quasiquote [()])
;=>[()]
(quasiquote ([]))
;=>([])
(def! a 8)
;=>8
`[1 a 3]
;=>[1 a 3]
(quasiquote [a [] b [c] d [e f] g])
;=>[a [] b [c] d [e f] g]

;; Testing unquote with vectors
`[~a]
;=>[8]
`[(~a)]
;=>[(8)]
`([~a])
;=>([8])
`[a ~a a]
;=>[a 8 a]
`([a ~a a])
;=>([a 8 a])
`[(a ~a a)]
;=>[(a 8 a)]

;; Testing splice-unquote with vectors
(def! c '(1 "b" "d"))
;=>(1 "b" "d")
`[~@c]
;=>[1 "b" "d"]
`[(~@c)]
;=>[(1 "b" "d")]
`([~@c])
;=>([1 "b" "d"])
`[1 ~@c 3]
;=>[1 1 "b" "d" 3]
`([1 ~@c 3])
;=>([1 1 "b" "d" 3])
`[(1 ~@c 3)]
;=>[(1 1 "b" "d" 3)]

;; Misplaced unquote or splice-unquote
`(0 unquote)
;=>(0 unquote)
`(0 splice-unquote)
;=>(0 splice-unquote)
`[unquote 0]
;=>[unquote 0]
`[splice-unquote 0]
;=>[splice-unquote 0]

;; Debugging quasiquote
(quasiquoteexpand nil)
;=>nil
(quasiquoteexpand 7)
;=>7
(quasiquoteexpand a)
;=>(quote a)
(quasiquoteexpand {"a" b})
;=>(quote {"a" b})
(quasiquoteexpand ())
;=>()
(quasiquoteexpand (1 2 3))
;=>(cons 1 (cons 2 (cons 3 ())))
(quasiquoteexpand (a))
;=>(cons (quote a) ())
(quasiquoteexpand (1 2 (3 4)))
;=>(cons 1 (cons 2 (cons (cons 3 (cons 4 ())) ())))
(quasiquoteexpand (nil))
;=>(cons nil ())
(quasiquoteexpand (1 ()))
;=>(cons 1 (cons () ()))
(quasiquoteexpand (() 1))
;=>(cons () (cons 1 ()))
(quasiquoteexpand (1 () 2))
;=>(cons 1 (cons () (cons 2 ())))
(quasiquoteexpand (()))
;=>(cons () ())
(quasiquoteexpand (f () g (h) i (j k) l))
;=>(cons (quote f) (cons () (cons (quote g) (cons (cons (quote h) ()) (cons (quote i) (cons (cons (quote j) (cons (quote k) ())) (cons (quote l) ())))))))
(quasiquoteexpand (unquote 7))
;=>7
(quasiquoteexpand a)
;=>(quote a)
(quasiquoteexpand (unquote a))
;=>a
(quasiquoteexpand (1 a 3))
;=>(cons 1 (cons (quote a) (cons 3 ())))
(quasiquoteexpand (1 (unquote a) 3))
;=>(cons 1 (cons a (cons 3 ())))
(quasiquoteexpand (1 b 3))
;=>(cons 1 (cons (quote b) (cons 3 ())))
(quasiquoteexpand (1 (unquote b) 3))
;=>(cons 1 (cons b (cons 3 ())))
(quasiquoteexpand ((unquote 1) (unquote 2)))
;=>(cons 1 (cons 2 ()))
(quasiquoteexpand (a (splice-unquote (b c)) d))
;=>(cons (quote a) (concat (b c) (cons (quote d) ())))
(quasiquoteexpand (1 c 3))
;=>(cons 1 (cons (quote c) (cons 3 ())))
(quasiquoteexpand (1 (splice-unquote c) 3))
;=>(cons 1 (concat c (cons 3 ())))
(quasiquoteexpand (1 (splice-unquote c)))
;=>(cons 1 (concat c ()))
(quasiquoteexpand ((splice-unquote c) 2))
;=>(concat c (cons 2 ()))
(quasiquoteexpand ((splice-unquote c) (splice-unquote c)))
;=>(concat c (concat c ()))
(quasiquoteexpand [])
;=>(vec ())
(quasiquoteexpand [[]])
;=>(vec (cons (vec ()) ()))
(quasiquoteexpand [()])
;=>(vec (cons () ()))
(quasiquoteexpand ([]))
;=>(cons (vec ()) ())
(quasiquoteexpand [1 a 3])
;=>(vec (cons 1 (cons (quote a) (cons 3 ()))))
(quasiquoteexpand [a [] b [c] d [e f] g])
;=>(vec (cons (quote a) (cons (vec ()) (cons (quote b) (cons (vec (cons (quote c) ())) (cons (quote d) (cons (vec (cons (quote e) (cons (quote f) ()))) (cons (quote g) ()))))))))
复制代码

;;; TODO: really a step5 test
;;
;; Testing that (do (do)) not broken by TCO
(do (do 1 2))
;=>2

;;
;; Testing read-string, eval and slurp
(read-string "(1 2 (3 4) nil)")
;=>(1 2 (3 4) nil)

(= nil (read-string "nil"))
;=>true

(read-string "(+ 2 3)")
;=>(+ 2 3)

(read-string "\"\n\"")
;=>"\n"

(read-string "7 ;; comment")
;=>7

;;; Differing output, but make sure no fatal error
(read-string ";; comment")


(eval (read-string "(+ 2 3)"))
;=>5

(slurp "../tests/test.txt")
;=>"A line of text\n"

;;; Load the same file twice.
(slurp "../tests/test.txt")
;=>"A line of text\n"

;; Testing load-file

(load-file "../tests/inc.mal")
;=>nil
(inc1 7)
;=>8
(inc2 7)
;=>9
(inc3 9)
;=>12

;;
;; Testing atoms

(def! inc3 (fn* (a) (+ 3 a)))

(def! a (atom 2))
;=>(atom 2)

(atom? a)
;=>true

(atom? 1)
;=>false

(deref a)
;=>2

(reset! a 3)
;=>3

(deref a)
;=>3

(swap! a inc3)
;=>6

(deref a)
;=>6

(swap! a (fn* (a) a))
;=>6

(swap! a (fn* (a) (* 2 a)))
;=>12

(swap! a (fn* (a b) (* a b)) 10)
;=>120

(swap! a + 3)
;=>123

;; Testing swap!/closure interaction
(def! inc-it (fn* (a) (+ 1 a)))
(def! atm (atom 7))
(def! f (fn* () (swap! atm inc-it)))
(f)
;=>8
(f)
;=>9

;; Testing whether closures can retain atoms
(def! g (let* (atm (atom 0)) (fn* () (deref atm))))
(def! atm (atom 1))
(g)
;=>0

;>>> deferrable=True
;;
;; -------- Deferrable Functionality --------

;; Testing reading of large files
(load-file "../tests/computations.mal")
;=>nil
(sumdown 2)
;=>3
(fib 2)
;=>1

;; Testing `@` reader macro (short for `deref`)
(def! atm (atom 9))
@atm
;=>9

;;; TODO: really a step5 test
;; Testing that vector params not broken by TCO
(def! g (fn* [] 78))
(g)
;=>78
(def! g (fn* [a] (+ a 78)))
(g 3)
;=>81

;;
;; Testing that *ARGV* exists and is an empty list
(list? *ARGV*)
;=>true
*ARGV*
;=>()

;;
;; Testing that eval sets aa in root scope, and that it is found in nested scope
(let* (b 12) (do (eval (read-string "(def! aa 7)")) aa ))
;=>7

;>>> soft=True
;>>> optional=True
;;
;; -------- Optional Functionality --------

;; Testing comments in a file
(load-file "../tests/incB.mal")
;=>nil
(inc4 7)
;=>11
(inc5 7)
;=>12

;; Testing map literal across multiple lines in a file
(load-file "../tests/incC.mal")
;=>nil
mymap
;=>{"a" 1}

;; Checking that eval does not use local environments.
(def! a 1)
;=>1
(let* (a 2) (eval (read-string "a")))
;=>1

;; Non alphanumeric characters in comments in read-string
(read-string "1;!")
;=>1
(read-string "1;\"")
;=>1
(read-string "1;#")
;=>1
(read-string "1;$")
;=>1
(read-string "1;%")
;=>1
(read-string "1;'")
;=>1
(read-string "1;\\")
;=>1
(read-string "1;\\\\")
;=>1
(read-string "1;\\\\\\")
;=>1
(read-string "1;`")
;=>1
;;; Hopefully less problematic characters can be checked together
(read-string "1; &()*+,-./:;<=>?@[]^_{|}~")
;=>1
复制代码

;; Testing trivial macros
(defmacro! one (fn* () 1))
(one)
;=>1
(defmacro! two (fn* () 2))
(two)
;=>2

;; Testing unless macros
(defmacro! unless (fn* (pred a b) `(if ~pred ~b ~a)))
(unless false 7 8)
;=>7
(unless true 7 8)
;=>8
(defmacro! unless2 (fn* (pred a b) (list 'if (list 'not pred) a b)))
(unless2 false 7 8)
;=>7
(unless2 true 7 8)
;=>8

;; Testing macroexpand
(macroexpand (one))
;=>1
(macroexpand (unless PRED A B))
;=>(if PRED B A)
(macroexpand (unless2 PRED A B))
;=>(if (not PRED) A B)
(macroexpand (unless2 2 3 4))
;=>(if (not 2) 3 4)

;; Testing evaluation of macro result
(defmacro! identity (fn* (x) x))
(let* (a 123) (macroexpand (identity a)))
;=>a
(let* (a 123) (identity a))
;=>123

;; Test that macros do not break empty list
()
;=>()

;; Test that macros do not break quasiquote
`(1)
;=>(1)

;>>> deferrable=True
;;
;; -------- Deferrable Functionality --------

;; Testing non-macro function
(not (= 1 1))
;=>false
;;; This should fail if it is a macro
(not (= 1 2))
;=>true

;; Testing nth, first and rest functions

(nth (list 1) 0)
;=>1
(nth (list 1 2) 1)
;=>2
(nth (list 1 2 nil) 2)
;=>nil
(def! x "x")
(def! x (nth (list 1 2) 2))
x
;=>"x"

(first (list))
;=>nil
(first (list 6))
;=>6
(first (list 7 8 9))
;=>7

(rest (list))
;=>()
(rest (list 6))
;=>()
(rest (list 7 8 9))
;=>(8 9)


;; Testing cond macro

(macroexpand (cond))
;=>nil
(cond)
;=>nil
(macroexpand (cond X Y))
;=>(if X Y (cond))
(cond true 7)
;=>7
(cond false 7)
;=>nil
(macroexpand (cond X Y Z T))
;=>(if X Y (cond Z T))
(cond true 7 true 8)
;=>7
(cond false 7 true 8)
;=>8
(cond false 7 false 8 "else" 9)
;=>9
(cond false 7 (= 2 2) 8 "else" 9)
;=>8
(cond false 7 false 8 false 9)
;=>nil

;; Testing EVAL in let*

(let* (x (cond false "no" true "yes")) x)
;=>"yes"


;; Testing nth, first, rest with vectors

(nth [1] 0)
;=>1
(nth [1 2] 1)
;=>2
(nth [1 2 nil] 2)
;=>nil
(def! x "x")
(def! x (nth [1 2] 2))
x
;=>"x"

(first [])
;=>nil
(first nil)
;=>nil
(first [10])
;=>10
(first [10 11 12])
;=>10
(rest [])
;=>()
(rest nil)
;=>()
(rest [10])
;=>()
(rest [10 11 12])
;=>(11 12)
(rest (cons 10 [11 12]))
;=>(11 12)

;; Testing EVAL in vector let*

(let* [x (cond false "no" true "yes")] x)
;=>"yes"

;>>> soft=True
;>>> optional=True
;;
;; ------- Optional Functionality --------------
;; ------- (Not needed for self-hosting) -------

;; Test that macros use closures
(def! x 2)
(defmacro! a (fn* [] x))
(a)
;=>2
(let* (x 3) (a))
;=>2
复制代码

;;
;; Testing throw

(throw "err1")
;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*err1.*

;;
;; Testing try*/catch*

(try* 123 (catch* e 456))
;=>123

(try* abc (catch* exc (prn "exc is:" exc)))
;/"exc is:" "'abc' not found"
;=>nil

(try* (abc 1 2) (catch* exc (prn "exc is:" exc)))
;/"exc is:" "'abc' not found"
;=>nil

;; Make sure error from core can be caught
(try* (nth () 1) (catch* exc (prn "exc is:" exc)))
;/"exc is:".*(length|range|[Bb]ounds|beyond).*
;=>nil

(try* (throw "my exception") (catch* exc (do (prn "exc:" exc) 7)))
;/"exc:" "my exception"
;=>7

;; Test that exception handlers get restored correctly
(try* (do (try* "t1" (catch* e "c1")) (throw "e1")) (catch* e "c2"))
;=>"c2"
(try* (try* (throw "e1") (catch* e (throw "e2"))) (catch* e "c2"))
;=>"c2"

;;; Test that throw is a function:
(try* (map throw (list "my err")) (catch* exc exc))
;=>"my err"


;;
;; Testing builtin functions

(symbol? 'abc)
;=>true
(symbol? "abc")
;=>false

(nil? nil)
;=>true
(nil? true)
;=>false

(true? true)
;=>true
(true? false)
;=>false
(true? true?)
;=>false

(false? false)
;=>true
(false? true)
;=>false

;; Testing apply function with core functions
(apply + (list 2 3))
;=>5
(apply + 4 (list 5))
;=>9
(apply prn (list 1 2 "3" (list)))
;/1 2 "3" \(\)
;=>nil
(apply prn 1 2 (list "3" (list)))
;/1 2 "3" \(\)
;=>nil
(apply list (list))
;=>()
(apply symbol? (list (quote two)))
;=>true

;; Testing apply function with user functions
(apply (fn* (a b) (+ a b)) (list 2 3))
;=>5
(apply (fn* (a b) (+ a b)) 4 (list 5))
;=>9

;; Testing map function
(def! nums (list 1 2 3))
(def! double (fn* (a) (* 2 a)))
(double 3)
;=>6
(map double nums) 
;=>(2 4 6)
(map (fn* (x) (symbol? x)) (list 1 (quote two) "three"))
;=>(false true false)
(= () (map str ()))
;=>true

;>>> deferrable=True
;;
;; ------- Deferrable Functionality ----------
;; ------- (Needed for self-hosting) -------

;; Testing symbol and keyword functions
(symbol? :abc)
;=>false
(symbol? 'abc)
;=>true
(symbol? "abc")
;=>false
(symbol? (symbol "abc"))
;=>true
(keyword? :abc)
;=>true
(keyword? 'abc)
;=>false
(keyword? "abc")
;=>false
(keyword? "")
;=>false
(keyword? (keyword "abc"))
;=>true

(symbol "abc")
;=>abc
(keyword "abc")
;=>:abc

;; Testing sequential? function

(sequential? (list 1 2 3))
;=>true
(sequential? [15])
;=>true
(sequential? sequential?)
;=>false
(sequential? nil)
;=>false
(sequential? "abc")
;=>false

;; Testing apply function with core functions and arguments in vector
(apply + 4 [5])
;=>9
(apply prn 1 2 ["3" 4])
;/1 2 "3" 4
;=>nil
(apply list [])
;=>()
;; Testing apply function with user functions and arguments in vector
(apply (fn* (a b) (+ a b)) [2 3])
;=>5
(apply (fn* (a b) (+ a b)) 4 [5])
;=>9


;; Testing map function with vectors
(map (fn* (a) (* 2 a)) [1 2 3])
;=>(2 4 6)

(map (fn* [& args] (list? args)) [1 2])
;=>(true true)

;; Testing vector functions

(vector? [10 11])
;=>true
(vector? '(12 13))
;=>false
(vector 3 4 5)
;=>[3 4 5]
(= [] (vector))
;=>true

(map? {})
;=>true
(map? '())
;=>false
(map? [])
;=>false
(map? 'abc)
;=>false
(map? :abc)
;=>false


;;
;; Testing hash-maps
(hash-map "a" 1)
;=>{"a" 1}

{"a" 1}
;=>{"a" 1}

(assoc {} "a" 1)
;=>{"a" 1}

(get (assoc (assoc {"a" 1 } "b" 2) "c" 3) "a")
;=>1

(def! hm1 (hash-map))
;=>{}

(map? hm1)
;=>true
(map? 1)
;=>false
(map? "abc")
;=>false

(get nil "a")
;=>nil

(get hm1 "a")
;=>nil

(contains? hm1 "a")
;=>false

(def! hm2 (assoc hm1 "a" 1))
;=>{"a" 1}

(get hm1 "a")
;=>nil

(contains? hm1 "a")
;=>false

(get hm2 "a")
;=>1

(contains? hm2 "a")
;=>true


;;; TODO: fix. Clojure returns nil but this breaks mal impl
(keys hm1)
;=>()
(= () (keys hm1))
;=>true

(keys hm2)
;=>("a")

(keys {"1" 1})
;=>("1")

;;; TODO: fix. Clojure returns nil but this breaks mal impl
(vals hm1)
;=>()
(= () (vals hm1))
;=>true

(vals hm2)
;=>(1)

(count (keys (assoc hm2 "b" 2 "c" 3)))
;=>3

;; Testing keywords as hash-map keys
(get {:abc 123} :abc)
;=>123
(contains? {:abc 123} :abc)
;=>true
(contains? {:abcd 123} :abc)
;=>false
(assoc {} :bcd 234)
;=>{:bcd 234}
(keyword? (nth (keys {:abc 123 :def 456}) 0))
;=>true
(keyword? (nth (vals {"a" :abc "b" :def}) 0))
;=>true

;; Testing whether assoc updates properly
(def! hm4 (assoc {:a 1 :b 2} :a 3 :c 1))
(get hm4 :a)
;=>3
(get hm4 :b)
;=>2
(get hm4 :c)
;=>1

;; Testing nil as hash-map values
(contains? {:abc nil} :abc)
;=>true
(assoc {} :bcd nil)
;=>{:bcd nil}

;;
;; Additional str and pr-str tests

(str "A" {:abc "val"} "Z")
;=>"A{:abc val}Z"

(str true "." false "." nil "." :keyw "." 'symb)
;=>"true.false.nil.:keyw.symb"

(pr-str "A" {:abc "val"} "Z")
;=>"\"A\" {:abc \"val\"} \"Z\""

(pr-str true "." false "." nil "." :keyw "." 'symb)
;=>"true \".\" false \".\" nil \".\" :keyw \".\" symb"

(def! s (str {:abc "val1" :def "val2"}))
(cond (= s "{:abc val1 :def val2}") true (= s "{:def val2 :abc val1}") true)
;=>true

(def! p (pr-str {:abc "val1" :def "val2"}))
(cond (= p "{:abc \"val1\" :def \"val2\"}") true (= p "{:def \"val2\" :abc \"val1\"}") true)
;=>true

;;
;; Test extra function arguments as Mal List (bypassing TCO with apply)
(apply (fn* (& more) (list? more)) [1 2 3])
;=>true
(apply (fn* (& more) (list? more)) [])
;=>true
(apply (fn* (a & more) (list? more)) [1])
;=>true

;>>> soft=True
;>>> optional=True
;;
;; ------- Optional Functionality --------------
;; ------- (Not needed for self-hosting) -------


;; Testing throwing a hash-map
(throw {:msg "err2"})
;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*msg.*err2.*

;;;TODO: fix so long lines don't trigger ANSI escape codes ;;;(try*
;;;(try* (throw ["data" "foo"]) (catch* exc (do (prn "exc is:" exc) 7))) ;;;;
;;;; "exc is:" ["data" "foo"] ;;;;=>7
;;;;=>7

;;
;; Testing try* without catch*
(try* xyz)
;/.*\'?xyz\'? not found.*

;;
;; Testing throwing non-strings
(try* (throw (list 1 2 3)) (catch* exc (do (prn "err:" exc) 7)))
;/"err:" \(1 2 3\)
;=>7

;;
;; Testing dissoc
(def! hm3 (assoc hm2 "b" 2))
(count (keys hm3))
;=>2
(count (vals hm3))
;=>2
(dissoc hm3 "a")
;=>{"b" 2}
(dissoc hm3 "a" "b")
;=>{}
(dissoc hm3 "a" "b" "c")
;=>{}
(count (keys hm3))
;=>2

(dissoc {:cde 345 :fgh 456} :cde)
;=>{:fgh 456}
(dissoc {:cde nil :fgh 456} :cde)
;=>{:fgh 456}

;;
;; Testing equality of hash-maps
(= {} {})
;=>true
(= {} (hash-map))
;=>true
(= {:a 11 :b 22} (hash-map :b 22 :a 11))
;=>true
(= {:a 11 :b [22 33]} (hash-map :b [22 33] :a 11))
;=>true
(= {:a 11 :b {:c 33}} (hash-map :b {:c 33} :a 11))
;=>true
(= {:a 11 :b 22} (hash-map :b 23 :a 11))
;=>false
(= {:a 11 :b 22} (hash-map :a 11))
;=>false
(= {:a [11 22]} {:a (list 11 22)})
;=>true
(= {:a 11 :b 22} (list :a 11 :b 22))
;=>false
(= {} [])
;=>false
(= [] {})
;=>false

(keyword :abc)
;=>:abc
(keyword? (first (keys {":abc" 123 ":def" 456})))
;=>false

;; Testing that hashmaps don't alter function ast
(def! bar (fn* [a] {:foo (get a :foo)}))
(bar {:foo (fn* [x] x)})
(bar {:foo 3})
;; shouldn't give an error
复制代码

;;;
;;; See IMPL/tests/stepA_mal.mal for implementation specific
;;; interop tests.
;;;


;;
;; Testing readline
(readline "mal-user> ")
"hello"
;=>"\"hello\""

;;
;; Testing *host-language*
;;; each impl is different, but this should return false
;;; rather than throwing an exception
(= "something bogus" *host-language*)
;=>false


;>>> deferrable=True
;;
;; ------- Deferrable Functionality ----------
;; ------- (Needed for self-hosting) -------

;;
;;
;; Testing hash-map evaluation and atoms (i.e. an env)
(def! e (atom {"+" +}))
(swap! e assoc "-" -)
( (get @e "+") 7 8)
;=>15
( (get @e "-") 11 8)
;=>3
(swap! e assoc "foo" (list))
(get @e "foo")
;=>()
(swap! e assoc "bar" '(1 2 3))
(get @e "bar")
;=>(1 2 3)

;; Testing for presence of optional functions
(do (list time-ms string? number? seq conj meta with-meta fn?) nil)
;=>nil

(map symbol? '(nil false true))
;=>(false false false)

;; ------------------------------------------------------------------

;>>> soft=True
;>>> optional=True
;;
;; ------- Optional Functionality --------------
;; ------- (Not needed for self-hosting) -------

;; Testing metadata on functions

;;
;; Testing metadata on mal functions

(meta (fn* (a) a))
;=>nil

(meta (with-meta (fn* (a) a) {"b" 1}))
;=>{"b" 1}

(meta (with-meta (fn* (a) a) "abc"))
;=>"abc"

(def! l-wm (with-meta (fn* (a) a) {"b" 2}))
(meta l-wm)
;=>{"b" 2}

(meta (with-meta l-wm {"new_meta" 123}))
;=>{"new_meta" 123}
(meta l-wm)
;=>{"b" 2}

(def! f-wm (with-meta (fn* [a] (+ 1 a)) {"abc" 1}))
(meta f-wm)
;=>{"abc" 1}

(meta (with-meta f-wm {"new_meta" 123}))
;=>{"new_meta" 123}
(meta f-wm)
;=>{"abc" 1}

(def! f-wm2 ^{"abc" 1} (fn* [a] (+ 1 a)))
(meta f-wm2)
;=>{"abc" 1}

;; Meta of native functions should return nil (not fail)
(meta +)
;=>nil

;;
;; Make sure closures and metadata co-exist
(def! gen-plusX (fn* (x) (with-meta (fn* (b) (+ x b)) {"meta" 1})))
(def! plus7 (gen-plusX 7))
(def! plus8 (gen-plusX 8))
(plus7 8)
;=>15
(meta plus7)
;=>{"meta" 1}
(meta plus8)
;=>{"meta" 1}
(meta (with-meta plus7 {"meta" 2}))
;=>{"meta" 2}
(meta plus8)
;=>{"meta" 1}

;;
;; Testing string? function
(string? "")
;=>true
(string? 'abc)
;=>false
(string? "abc")
;=>true
(string? :abc)
;=>false
(string? (keyword "abc"))
;=>false
(string? 234)
;=>false
(string? nil)
;=>false

;; Testing number? function
(number? 123)
;=>true
(number? -1)
;=>true
(number? nil)
;=>false
(number? false)
;=>false
(number? "123")
;=>false

(def! add1 (fn* (x) (+ x 1)))

;; Testing fn? function
(fn? +)
;=>true
(fn? add1)
;=>true
(fn? cond)
;=>false
(fn? "+")
;=>false
(fn? :+)
;=>false
(fn? ^{"ismacro" true} (fn* () 0))
;=>true

;; Testing macro? function
(macro? cond)
;=>true
(macro? +)
;=>false
(macro? add1)
;=>false
(macro? "+")
;=>false
(macro? :+)
;=>false
(macro? {})
;=>false


;;
;; Testing conj function
(conj (list) 1)
;=>(1)
(conj (list 1) 2)
;=>(2 1)
(conj (list 2 3) 4)
;=>(4 2 3)
(conj (list 2 3) 4 5 6)
;=>(6 5 4 2 3)
(conj (list 1) (list 2 3))
;=>((2 3) 1)

(conj [] 1)
;=>[1]
(conj [1] 2)
;=>[1 2]
(conj [2 3] 4)
;=>[2 3 4]
(conj [2 3] 4 5 6)
;=>[2 3 4 5 6]
(conj [1] [2 3])
;=>[1 [2 3]]

;;
;; Testing seq function
(seq "abc")
;=>("a" "b" "c")
(apply str (seq "this is a test"))
;=>"this is a test"
(seq '(2 3 4))
;=>(2 3 4)
(seq [2 3 4])
;=>(2 3 4)

(seq "")
;=>nil
(seq '())
;=>nil
(seq [])
;=>nil
(seq nil)
;=>nil

;;
;; Testing metadata on collections

(meta [1 2 3])
;=>nil

(with-meta [1 2 3] {"a" 1})
;=>[1 2 3]

(meta (with-meta [1 2 3] {"a" 1}))
;=>{"a" 1}

(vector? (with-meta [1 2 3] {"a" 1}))
;=>true

(meta (with-meta [1 2 3] "abc"))
;=>"abc"

(with-meta [] "abc")
;=>[]

(meta (with-meta (list 1 2 3) {"a" 1}))
;=>{"a" 1}

(list? (with-meta (list 1 2 3) {"a" 1}))
;=>true

(with-meta (list) {"a" 1})
;=>()

(empty? (with-meta (list) {"a" 1}))
;=>true

(meta (with-meta {"abc" 123} {"a" 1}))
;=>{"a" 1}

(map? (with-meta {"abc" 123} {"a" 1}))
;=>true

(with-meta {} {"a" 1})
;=>{}

(def! l-wm (with-meta [4 5 6] {"b" 2}))
;=>[4 5 6]
(meta l-wm)
;=>{"b" 2}

(meta (with-meta l-wm {"new_meta" 123}))
;=>{"new_meta" 123}
(meta l-wm)
;=>{"b" 2}

;;
;; Testing metadata on builtin functions
(meta +)
;=>nil
(def! f-wm3 ^{"def" 2} +)
(meta f-wm3)
;=>{"def" 2}
(meta +)
;=>nil

;; Loading sumdown from computations.mal
(load-file "../tests/computations.mal")
;=>nil

;;
;; Testing time-ms function
(def! start-time (time-ms))
(= start-time 0)
;=>false
(sumdown 10) ; Waste some time
;=>55
(> (time-ms) start-time)
;=>true

;;
;; Test that defining a macro does not mutate an existing function.
(def! f (fn* [x] (number? x)))
(defmacro! m f)
(f (+ 1 1))
;=>true
(m (+ 1 1))
;=>false
复制代码

CrLf

牛逼

老刘1号

回复 4# CrLf


    其实准备再用bat写一遍（还没动手

老刘1号

回复 6# jyswjjgdwtdtj


    今天发现个陈年老BUG，刚才才给修了，自己挖自己的坟帖了属于是（