mirror of
https://github.com/kanaka/mal.git
synced 2024-10-05 18:08:55 +03:00
vbs: add some functions
This commit is contained in:
OldLiu
Joel Martin
parent
7136b8d877
commit
f1eb294ece
@ -1,281 +1,142 @@
|
||||
Include "Types.vbs"
|
||||
Option Explicit
|
||||
|
||||
Sub Include(strFileName)
|
||||
With CreateObject("Scripting.FileSystemObject")
|
||||
ExecuteGlobal .OpenTextFile( _
|
||||
.GetParentFolderName( _
|
||||
.GetFile(WScript.ScriptFullName)) & _
|
||||
"\" & strFileName).ReadAll
|
||||
End With
|
||||
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
|
||||
|
||||
' Public objCoreNS
|
||||
' Set objCoreNS = CreateObject("Scripting.Dictionary")
|
||||
' objCoreNS.Add "+", GetRef("Add")
|
||||
' objCoreNS.Add "-", GetRef("Subtract")
|
||||
' objCoreNS.Add "*", GetRef("Multiply")
|
||||
' objCoreNS.Add "/", GetRef("Divide")
|
||||
' objCoreNS.Add "list", GetRef("mMakeList")
|
||||
' objCoreNS.Add "list?", GetRef("mIsList") '1
|
||||
' objCoreNS.Add "empty?", GetRef("mIsListEmpty") '1
|
||||
' objCoreNS.Add "count", GetRef("mListCount") '1
|
||||
' objCoreNS.Add "=", GetRef("mEqual") '2 'both type & value
|
||||
' objCoreNS.Add "<", GetRef("mLess") '2 'number only
|
||||
' objCoreNS.Add ">", GetRef("mGreater") '2 'number only
|
||||
' objCoreNS.Add "<=", GetRef("mEqualLess") '2 'number only
|
||||
' objCoreNS.Add ">=", GetRef("mEqualGreater") '2 'number only
|
||||
' objCoreNS.Add "pr-str", GetRef("mprstr") 'all 'ret str 'readable 'concat by space
|
||||
' objCoreNS.Add "str", GetRef("mstr") 'all 'ret str '!readable 'concat by ""
|
||||
' objCoreNS.Add "prn", GetRef("mprn") 'all 'to screen ret nil 'concat by space 'readable
|
||||
' objCoreNS.Add "println", GetRef("mprintln") 'all 'to screen ret nil 'concat by space '!readable
|
||||
' objCoreNS.Add "get", GetRef("mGet")
|
||||
' objCoreNS.Add "set", GetRef("mSet")
|
||||
' objCoreNS.Add "first", GetRef("mFirst")
|
||||
' objCoreNS.Add "last", GetRef("mLast")
|
||||
Function IsListOrVec(objMal)
|
||||
IsListOrVec = _
|
||||
objMal.Type = TYPES.LIST Or _
|
||||
objMal.Type = TYPES.VECTOR
|
||||
End Function
|
||||
|
||||
' Function mLast(objArgs)
|
||||
' Set objRes = New MalType
|
||||
' objRes.Type = TYPE_LIST
|
||||
' set objRes.value = createobject("system.collections.arraylist")
|
||||
' for i = 1 to objArgs.value.item(1).value.count - 1
|
||||
' objRes.value.add objArgs.value.item(1).value.item(i)
|
||||
' next
|
||||
' Set mLast= objRes
|
||||
' 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
|
||||
|
||||
' Function mFirst(objArgs)
|
||||
' 'Set objRes = New MalType
|
||||
' Set objRes = objArgs.value.item(1).value.item(0)
|
||||
' Set mFirst= objRes
|
||||
' 'msgbox 1
|
||||
' End Function
|
||||
Dim objNS
|
||||
Set objNS = NewEnv(Nothing)
|
||||
|
||||
' Function mGet(objArgs)
|
||||
' Set objRes = New MalType
|
||||
' 'objRes.Type =
|
||||
' Set objList = objArgs.value.item(1)
|
||||
' numIndex = objArgs.value.item(2).value
|
||||
' Set objRes = objList.value.Item(numIndex)
|
||||
' 'MsgBox objRes.type
|
||||
' Set mGet = objRes
|
||||
' End Function
|
||||
Function MAdd(objArgs)
|
||||
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 mSet(objArgs)
|
||||
' Set objRes = New MalType
|
||||
' 'objRes.Type =
|
||||
' 'MsgBox 1
|
||||
' Set objList = objArgs.value.item(1)
|
||||
' numIndex = objArgs.value.item(2).value
|
||||
' 'MsgBox numIndex
|
||||
' Set objReplace = objArgs.value.item(3)
|
||||
' Set objList.value.Item(numIndex) = objReplace
|
||||
' 'MsgBox objRes.type
|
||||
' Set mSet = New MalType
|
||||
' mSet.Type = TYPE_NIL
|
||||
' End Function
|
||||
Function MSub(objArgs)
|
||||
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 mprintln(objArgs)
|
||||
' Dim objRes,i
|
||||
' Set objRes = New MalType
|
||||
' objRes.Type = TYPE_NIL
|
||||
' For i = 1 To objArgs.Value.Count - 2
|
||||
' wsh.stdout.write PrintMalType(objArgs.Value.Item(i), False) & " "
|
||||
' Next
|
||||
' If objArgs.Value.Count - 1 > 0 Then
|
||||
' wsh.stdout.write PrintMalType(objArgs.Value.Item(objArgs.Value.Count - 1), False)
|
||||
' End If
|
||||
' Set mprintln=objRes
|
||||
' End Function
|
||||
Function MMul(objArgs)
|
||||
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 mprn(objArgs)
|
||||
' Dim objRes,i
|
||||
' Set objRes = New MalType
|
||||
' objRes.Type = TYPE_NIL
|
||||
' For i = 1 To objArgs.Value.Count - 2
|
||||
' wsh.stdout.write PrintMalType(objArgs.Value.Item(i), True) & " "
|
||||
' Next
|
||||
' If objArgs.Value.Count - 1 > 0 Then
|
||||
' wsh.stdout.write PrintMalType(objArgs.Value.Item(objArgs.Value.Count - 1), True)
|
||||
' End If
|
||||
' Set mprn=objRes
|
||||
' End Function
|
||||
Function MDiv(objArgs)
|
||||
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 mstr(objArgs)
|
||||
' Dim objRes,i
|
||||
' Set objRes = New MalType
|
||||
' objRes.Type = TYPE_STRING
|
||||
' objRes.Value = ""
|
||||
' For i = 1 To objArgs.Value.Count - 1
|
||||
' objRes.Value = objRes.Value & PrintMalType(objArgs.Value.Item(i), False)
|
||||
' Next
|
||||
' Set mstr=objRes
|
||||
' End Function
|
||||
Function MList(objArgs)
|
||||
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 mprstr(objArgs)
|
||||
' Dim objRes,i
|
||||
' Set objRes = New MalType
|
||||
' objRes.Type = TYPE_STRING
|
||||
' objRes.Value = ""
|
||||
' For i = 1 To objArgs.Value.Count - 2
|
||||
' objRes.Value = objRes.Value & PrintMalType(objArgs.Value.Item(i), True) & " "
|
||||
' Next
|
||||
' If objArgs.Value.Count - 1 > 0 Then
|
||||
' objRes.Value = objRes.Value & PrintMalType(objArgs.Value.Item(objArgs.Value.Count - 1), True)
|
||||
' End If
|
||||
' Set mprstr=objRes
|
||||
' End Function
|
||||
Function MIsList(objArgs)
|
||||
CheckArgNum objArgs, 1
|
||||
|
||||
' Function mEqualGreater(objArgs)
|
||||
' CheckArgNum objArgs, 2
|
||||
' Dim objRes,i
|
||||
' Set objRes = New MalType
|
||||
' objRes.Type = TYPE_BOOLEAN
|
||||
' objRes.Value = (objArgs.Value.Item(1).Value >= objArgs.Value.Item(2).Value)
|
||||
' Set mEqualGreater = objRes
|
||||
' End Function
|
||||
Set MIsList = NewMalBool(objArgs.Item(1).Type = TYPES.LIST)
|
||||
End Function
|
||||
objNS.Add NewMalSym("list?"), NewVbsProc("MIsList", False)
|
||||
|
||||
' Function mEqualLess(objArgs)
|
||||
' CheckArgNum objArgs, 2
|
||||
' Dim objRes,i
|
||||
' Set objRes = New MalType
|
||||
' objRes.Type = TYPE_BOOLEAN
|
||||
' objRes.Value = (objArgs.Value.Item(1).Value <= objArgs.Value.Item(2).Value)
|
||||
' Set mEqualLess = objRes
|
||||
' End Function
|
||||
Function MIsEmpty(objArgs)
|
||||
CheckArgNum objArgs, 1
|
||||
CheckListOrVec objArgs.Item(1)
|
||||
|
||||
' Function mGreater(objArgs)
|
||||
' CheckArgNum objArgs, 2
|
||||
' Dim objRes,i
|
||||
' Set objRes = New MalType
|
||||
' objRes.Type = TYPE_BOOLEAN
|
||||
' objRes.Value = (objArgs.Value.Item(1).Value > objArgs.Value.Item(2).Value)
|
||||
' Set mGreater = objRes
|
||||
' End Function
|
||||
Set MIsEmpty = NewMalBool(objArgs.Item(1).Count = 0)
|
||||
End Function
|
||||
objNS.Add NewMalSym("empty?"), NewVbsProc("MIsEmpty", False)
|
||||
|
||||
Function MCount(objArgs)
|
||||
CheckArgNum objArgs, 1
|
||||
CheckListOrVec objArgs.Item(1)
|
||||
|
||||
' Function mLess(objArgs)
|
||||
' CheckArgNum objArgs, 2
|
||||
' Dim objRes,i
|
||||
' Set objRes = New MalType
|
||||
' objRes.Type = TYPE_BOOLEAN
|
||||
' objRes.Value = (objArgs.Value.Item(1).Value < objArgs.Value.Item(2).Value)
|
||||
' Set mLess = objRes
|
||||
' End Function
|
||||
Set MCount = NewMalNum(objArgs.Item(1).Count)
|
||||
End Function
|
||||
objNS.Add NewMalSym("count"), NewVbsProc("MCount", False)
|
||||
|
||||
Function MEqual(objArgs)
|
||||
Dim varRet
|
||||
CheckArgNum objArgs, 2
|
||||
|
||||
' Function mEqual(objArgs)
|
||||
' CheckArgNum objArgs, 2
|
||||
' Dim objRes,i
|
||||
' Set objRes = New MalType
|
||||
' objRes.Type = TYPE_BOOLEAN
|
||||
' objRes.Value = (objArgs.Value.Item(1).Type = objArgs.Value.Item(2).Type) Or _
|
||||
' ((objArgs.Value.Item(1).Type = TYPE_LIST Or objArgs.Value.Item(1).Type = TYPE_VECTOR) And _
|
||||
' (objArgs.Value.Item(2).Type = TYPE_LIST Or objArgs.Value.Item(2).Type = TYPE_VECTOR))
|
||||
' If objRes.Value Then
|
||||
' 'MsgBox objArgs.Value.Item(1).Type
|
||||
' If objArgs.Value.Item(1).Type = TYPE_LIST Or objArgs.Value.Item(1).Type = TYPE_VECTOR Then
|
||||
' objRes.Value = _
|
||||
' (objArgs.Value.Item(1).Value.Count = objArgs.Value.Item(2).Value.Count)
|
||||
' If objRes.Value Then
|
||||
' Dim objTemp
|
||||
' For i = 0 To objArgs.Value.Item(1).Value.Count - 1
|
||||
' 'an ugly recursion
|
||||
|
||||
' 'MsgBox objArgs.Value.Item(1).Value.Item(i).type
|
||||
' Set objTemp = New MalType
|
||||
' objTemp.Type = TYPE_LIST
|
||||
' Set objTemp.Value = CreateObject("System.Collections.Arraylist")
|
||||
' objTemp.Value.Add Null
|
||||
' objTemp.Value.Add objArgs.Value.Item(1).Value.Item(i)
|
||||
' objTemp.Value.Add objArgs.Value.Item(2).Value.Item(i)
|
||||
|
||||
' objRes.Value = objRes.Value And mEqual(objTemp).Value
|
||||
' Next
|
||||
' End If
|
||||
' Else
|
||||
' 'MsgBox objArgs.Value.Item(1).Value
|
||||
' 'MsgBox objArgs.Value.Item(2).Value
|
||||
' objRes.Value = _
|
||||
' (objArgs.Value.Item(1).Value = objArgs.Value.Item(2).Value)
|
||||
' End If
|
||||
' End If
|
||||
' Set mEqual = objRes
|
||||
' End Function
|
||||
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)))).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~"
|
||||
Case Else
|
||||
Set varRet = NewMalBool( _
|
||||
objArgs.Item(1).Value = objArgs.Item(2).Value)
|
||||
End Select
|
||||
End If
|
||||
End If
|
||||
|
||||
' Sub Er(sInfo)
|
||||
' boolError = True
|
||||
' strError = sInfo
|
||||
' End Sub
|
||||
Set MEqual = varRet
|
||||
End Function
|
||||
objNS.Add NewMalSym("="), NewVbsProc("MEqual", False)
|
||||
|
||||
' Function mListCount(objArgs)
|
||||
' CheckArgNum objArgs, 1
|
||||
' Dim objRes,i
|
||||
' Set objRes = New MalType
|
||||
' objRes.Type = TYPE_NUMBER
|
||||
' If objArgs.Value.Item(1).Type = TYPE_LIST Then
|
||||
' objRes.Value = objArgs.Value.Item(1).Value.Count
|
||||
' ElseIf objArgs.Value.Item(1).Type = TYPE_NIL Then
|
||||
' objRes.Value = 0
|
||||
' Else
|
||||
' Er "can't count"
|
||||
' End If
|
||||
' Set mListCount = objRes
|
||||
' End Function
|
||||
|
||||
' Function mIsListEmpty(objArgs)
|
||||
' CheckArgNum objArgs, 1
|
||||
' Dim objRes,i
|
||||
' Set objRes = New MalType
|
||||
' objRes.Type = TYPE_BOOLEAN
|
||||
' objRes.Value = (objArgs.Value.Item(1).Value.Count = 0)
|
||||
' Set mIsListEmpty = objRes
|
||||
' End Function
|
||||
|
||||
' Function mIsList(objArgs)
|
||||
' CheckArgNum objArgs, 1
|
||||
' Dim objRes,i
|
||||
' Set objRes = New MalType
|
||||
' objRes.Type = TYPE_BOOLEAN
|
||||
' objRes.Value = (objArgs.Value.Item(1).Type = TYPE_LIST)
|
||||
' Set mIsList = objRes
|
||||
' End Function
|
||||
|
||||
' Function mMakeList(objArgs)
|
||||
' Dim objRes,i
|
||||
' Set objRes = New MalType
|
||||
' objRes.Type = TYPE_LIST
|
||||
' Set objRes.Value = CreateObject("System.Collections.ArrayList")
|
||||
' For i = 1 To objArgs.Value.Count - 1
|
||||
' objRes.Value.Add objArgs.Value.Item(i)
|
||||
' Next
|
||||
' Set mMakeList = objRes
|
||||
' End Function
|
||||
|
||||
' Function Add(objArgs)
|
||||
' CheckArgNum objArgs, 2
|
||||
' Set Add = New MalType
|
||||
' Add.Type = TYPE_NUMBER
|
||||
' Add.Value = objArgs.Value.Item(1).Value + objArgs.Value.Item(2).Value
|
||||
' End Function
|
||||
|
||||
' Function Subtract(objArgs)
|
||||
' CheckArgNum objArgs, 2
|
||||
' Set Subtract = New MalType
|
||||
' Subtract.Type = TYPE_NUMBER
|
||||
' Subtract.Value = objArgs.Value.Item(1).Value - objArgs.Value.Item(2).Value
|
||||
' End Function
|
||||
|
||||
' Function Multiply(objArgs)
|
||||
' CheckArgNum objArgs, 2
|
||||
' Set Multiply = New MalType
|
||||
' Multiply.Type = TYPE_NUMBER
|
||||
' Multiply.Value = objArgs.Value.Item(1).Value * objArgs.Value.Item(2).Value
|
||||
' End Function
|
||||
|
||||
' Function Divide(objArgs)
|
||||
' CheckArgNum objArgs, 2
|
||||
' Set Divide = New MalType
|
||||
' Divide.Type = TYPE_NUMBER
|
||||
' Divide.Value = objArgs.Value.Item(1).Value \ objArgs.Value.Item(2).Value
|
||||
' End Function
|
||||
'Todo > < >= <= pr-str str prn println
|
||||
@ -24,41 +24,7 @@ Class Environment
|
||||
Public Property Set Self(objEnv)
|
||||
Set objSelf = objEnv
|
||||
End Property
|
||||
|
||||
' Public objBindings
|
||||
' Public Sub Init(objBinds, objExpressions)
|
||||
' Dim boolVarLen
|
||||
' boolVarLen = False
|
||||
|
||||
' Dim i
|
||||
' For i = 0 To objBinds.Value.Count - 1
|
||||
' If objBinds.Value.Item(i).Value = "&" Then flag=True
|
||||
' If flag Then
|
||||
' 'assume i+1 = objBinds.Value.Count - 1
|
||||
' Dim oTmp
|
||||
' Set oTmp = New MalType
|
||||
' oTmp.Type = TYPE_LIST
|
||||
' Set oTmp.Value = CreateObject("System.Collections.ArrayList")
|
||||
' Dim j
|
||||
' For j = i+1 To objExpressions.Value.Count - 1
|
||||
' oTmp.Value.Add Evaluate(objExpressions.Value.Item(j), objSelf)
|
||||
' Next
|
||||
' 'MsgBox objBinds.Value.Item(i+1)
|
||||
' Add objBinds.Value.Item(i+1).Value, oTmp
|
||||
' Exit For
|
||||
' Else
|
||||
' Add objBinds.Value.Item(i).Value, _
|
||||
' Evaluate(objExpressions.Value.Item(i+1), objSelf)
|
||||
' End If
|
||||
' 'wsh.echo objBinds.Value.Item(i).Value
|
||||
' 'wsh.echo objExpressions.Value.Item(i).type
|
||||
' 'wsh.echo TypeName(Evaluate(objExpressions.Value.Item(i), objSelf))
|
||||
' 'wsh.echo Evaluate(objExpressions.Value.Item(i), objSelf).type
|
||||
' Next
|
||||
' 'MsgBox objBindings("a")
|
||||
' End Sub
|
||||
|
||||
|
||||
Public Sub Add(varKey, varValue)
|
||||
Set objBinds.Item(varKey.Value) = varValue
|
||||
End Sub
|
||||
|
||||
@ -4,59 +4,10 @@ Include "Types.vbs"
|
||||
Include "Reader.vbs"
|
||||
Include "Printer.vbs"
|
||||
Include "Env.vbs"
|
||||
Include "Core.vbs"
|
||||
|
||||
Dim objEnv
|
||||
Set objEnv = NewEnv(Nothing)
|
||||
|
||||
Function MAdd(objArgs)
|
||||
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
|
||||
objEnv.Add NewMalSym("+"), NewVbsProc("MAdd", False)
|
||||
|
||||
Function MSub(objArgs)
|
||||
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
|
||||
objEnv.Add NewMalSym("-"), NewVbsProc("MSub", False)
|
||||
|
||||
Function MMul(objArgs)
|
||||
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
|
||||
objEnv.Add NewMalSym("*"), NewVbsProc("MMul", False)
|
||||
|
||||
Function MDiv(objArgs)
|
||||
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
|
||||
objEnv.Add NewMalSym("/"), NewVbsProc("MDiv", False)
|
||||
|
||||
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
|
||||
Set objEnv = objNS
|
||||
|
||||
Function MDef(objArgs, objEnv)
|
||||
Dim varRet
|
||||
@ -74,11 +25,7 @@ Function MLet(objArgs, objEnv)
|
||||
|
||||
Dim objBinds
|
||||
Set objBinds = objArgs.Item(1)
|
||||
If objBinds.Type <> TYPES.LIST And _
|
||||
objBinds.Type <> TYPES.VECTOR Then
|
||||
Err.Raise vbObjectError, _
|
||||
"MLet", "Wrong argument type."
|
||||
End If
|
||||
CheckListOrVec objBinds
|
||||
|
||||
If objBinds.Count Mod 2 <> 0 Then
|
||||
Err.Raise vbObjectError, _
|
||||
@ -135,13 +82,9 @@ Function MFn(objArgs, objEnv)
|
||||
|
||||
Dim objParams, objCode
|
||||
Set objParams = objArgs.Item(1)
|
||||
CheckListOrVec objParams
|
||||
Set objCode = objArgs.Item(2)
|
||||
If objParams.Type <> TYPES.LIST And _
|
||||
objParams.Type <> TYPES.VECTOR Then
|
||||
Err.Raise vbObjectError, _
|
||||
"MFn", "Wrong argument type."
|
||||
End If
|
||||
|
||||
|
||||
Dim i
|
||||
For i = 0 To objParams.Count - 1
|
||||
CheckType objParams.Item(i), TYPES.SYMBOL
|
||||
@ -250,355 +193,4 @@ Sub Include(strFileName)
|
||||
.GetFile(WScript.ScriptFullName)) & _
|
||||
"\" & strFileName).ReadAll
|
||||
End With
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
' Dim objRootEnv
|
||||
' Set objRootEnv = New Environment
|
||||
' objRootEnv.SetSelf objRootEnv
|
||||
' objRootEnv.SetOuter Nothing
|
||||
' Dim arrKeys, i
|
||||
' arrKeys = objCoreNS.Keys
|
||||
' For i = 0 To UBound(arrKeys)
|
||||
' objRootEnv.Add arrKeys(i), NewLambda(objCoreNS.Item(arrKeys(i)))
|
||||
' Next
|
||||
' objRootEnv.Add "def!", NewSpecialForm("def!")
|
||||
' objRootEnv.Add "let*", NewSpecialForm("let*")
|
||||
' objRootEnv.Add "do", NewSpecialForm("do")
|
||||
' objRootEnv.Add "if", NewSpecialForm("if")
|
||||
' objRootEnv.Add "fn*", NewSpecialForm("fn*")
|
||||
' REP "(def! not (fn* (a) (if a false true)))"
|
||||
|
||||
' Function NewLambda(objFunction)
|
||||
' Dim objMal
|
||||
' Set objMal = New MalType
|
||||
' Set objMal.Value = New BuiltInFunction
|
||||
' Set objMal.Value.Run = objFunction
|
||||
' objMal.Type = TYPE_LAMBDA
|
||||
' Set NewLambda = objMal
|
||||
' End Function
|
||||
|
||||
' Function NewSpecialForm(strValue)
|
||||
' Set NewSpecialForm = New MalType
|
||||
' NewSpecialForm.Value = strValue
|
||||
' NewSpecialForm.Type = TYPE_SPECIAL
|
||||
' End Function
|
||||
|
||||
' Function IsSpecialForm(objForm)
|
||||
' IsSpecialForm = (objForm.Type = TYPE_SPECIAL)
|
||||
' End Function
|
||||
|
||||
' Class SpecialForm
|
||||
' Public Value
|
||||
' End Class
|
||||
|
||||
' Sub CheckArgNum(objArgs, lngExpect)
|
||||
' If objArgs.Value.Count - 1 <> lngExpect Then
|
||||
' boolError = True
|
||||
' strError = "wrong number of arguments"
|
||||
' Call REPL()
|
||||
' End If
|
||||
' End Sub
|
||||
|
||||
' Call REPL()
|
||||
' Sub REPL()
|
||||
' Dim strCode, strResult
|
||||
' While True
|
||||
' If boolError Then
|
||||
' WScript.StdErr.WriteLine "ERROR: " & strError
|
||||
' boolError = False
|
||||
' End If
|
||||
' WScript.StdOut.Write("user> ")
|
||||
' On Error Resume Next
|
||||
' strCode = WScript.StdIn.ReadLine()
|
||||
' If Err.Number <> 0 Then WScript.Quit 0
|
||||
' On Error Goto 0
|
||||
' WScript.Echo REP(strCode)
|
||||
' Wend
|
||||
' End Sub
|
||||
|
||||
' Function Read(strCode)
|
||||
' Set Read = ReadString(strCode)
|
||||
' End Function
|
||||
|
||||
|
||||
' Function Evaluate(objCode, objEnv)
|
||||
' DEPTH = DEPTH + 1
|
||||
' Dim i
|
||||
' If TypeName(objCode) = "Nothing" Then
|
||||
' Call REPL()
|
||||
' End If
|
||||
|
||||
' If objCode.Type = TYPE_LIST Then
|
||||
' If objCode.Value.Count = 0 Then
|
||||
' Set Evaluate = objCode
|
||||
' Exit Function
|
||||
' End If
|
||||
|
||||
' Dim objSymbol
|
||||
' 'wsh.echo space(DEPTH*4)&"CHECK FIRST"
|
||||
' Set objSymbol = Evaluate(objCode.Value.Item(0), objEnv)
|
||||
' 'wsh.echo space(DEPTH*4)&"CHECK FIRST FINISH"
|
||||
' 'MsgBox objSymbol.type
|
||||
' If IsSpecialForm(objSymbol) Then
|
||||
' 'wsh.echo space(DEPTH*4)&"EVAL SPECIAL"
|
||||
' 'MsgBox TypeName(objCode.value)
|
||||
' Select Case objSymbol.Value
|
||||
' Case "def!"
|
||||
' 'MsgBox "<22><><EFBFBD><EFBFBD>def"
|
||||
' CheckArgNum objCode, 2
|
||||
' CheckSymbol objCode.Value.Item(1)
|
||||
' objEnv.Add objCode.Value.Item(1).Value, _
|
||||
' Evaluate(objCode.Value.Item(2), objEnv)
|
||||
' Set Evaluate = objEnv.Get(objCode.Value.Item(1).Value)
|
||||
' Case "let*"
|
||||
' Dim objNewEnv
|
||||
' Set objNewEnv = New Environment
|
||||
' objNewEnv.SetSelf objNewEnv
|
||||
' objNewEnv.SetOuter objEnv
|
||||
' CheckArgNum objCode, 2
|
||||
' CheckListOrVector objCode.Value.Item(1)
|
||||
' CheckEven objCode.Value.Item(1).Value.Count
|
||||
' With objCode.Value.Item(1).Value
|
||||
' For i = 0 To .Count - 1 Step 2
|
||||
' CheckSymbol .Item(i)
|
||||
' objNewEnv.Add .Item(i).Value, _
|
||||
' Evaluate(.Item(i + 1), objNewEnv)
|
||||
' Next
|
||||
' End With
|
||||
' Set Evaluate = Evaluate(objCode.Value.Item(2), objNewEnv)
|
||||
' Case "do"
|
||||
' Set Evaluate = EvaluateAST(objCode, objEnv)
|
||||
' Set Evaluate = Evaluate.Value.Item(Evaluate.Value.Count - 1)
|
||||
' Case "if"
|
||||
' Dim objCondition
|
||||
' 'MsgBox 1
|
||||
' Set objCondition = Evaluate(objCode.Value.Item(1), objEnv)
|
||||
' 'MsgBox 2
|
||||
' 'MsgBox IsNil(objCondition)
|
||||
' 'MsgBox IsFalse(objCondition)
|
||||
' If IsNil(objCondition) Or IsFalse(objCondition) Then
|
||||
' 'MsgBox 1
|
||||
' Select Case objCode.Value.Count - 1
|
||||
' Case 2
|
||||
' Set Evaluate = New MalType
|
||||
' Evaluate.Type = TYPE_NIL
|
||||
' Case 3
|
||||
' Set Evaluate = Evaluate(objCode.Value.Item(3), objEnv)
|
||||
' Case Else
|
||||
' 'TODO Err
|
||||
' End Select
|
||||
' Else
|
||||
' If objCode.Value.Count - 1 = 2 Or objCode.Value.Count - 1 = 3 Then
|
||||
' Set Evaluate = Evaluate(objCode.Value.Item(2), objEnv)
|
||||
' Else
|
||||
' 'TODO err
|
||||
' End If
|
||||
' End If
|
||||
' Case "fn*" 'lambda
|
||||
' CheckArgNum objCode, 2
|
||||
' Set Evaluate = New MalType
|
||||
' Evaluate.Type = TYPE_LAMBDA
|
||||
' Set Evaluate.Value = New Lambda
|
||||
' 'MsgBox 1
|
||||
' Set Evaluate.Value.objEnv = New Environment
|
||||
' Evaluate.Value.objEnv.SetSelf Evaluate.Value.objEnv
|
||||
' Evaluate.Value.objEnv.SetOuter objEnv
|
||||
' Set Evaluate.Value.objParameters = objCode.Value.Item(1)
|
||||
' Set Evaluate.Value.objBody = objCode.Value.Item(2)
|
||||
' 'MsgBox 1
|
||||
' End Select
|
||||
' 'wsh.echo space(DEPTH*4)&"EVAL SPECIAL FINISH"
|
||||
' Else
|
||||
' 'wsh.echo space(DEPTH*4)&"EVAL NORMAL"
|
||||
' 'MsgBox 2
|
||||
' 'objSymbol.Value.SetEnv objEnv
|
||||
' 'wsh.echo space(DEPTH*4)&"objcode","type",objCode.Type
|
||||
' 'If objCode.Type = 7 Then wsh.echo space(DEPTH*4)&objCode.value
|
||||
' 'If objCode.Type = 8 Then wsh.echo space(DEPTH*4)&objCode.value
|
||||
' 'If objCode.Type = 0 Then wsh.echo space(DEPTH*4)&PrintMalType(objCode,True)
|
||||
|
||||
' '<27><><EFBFBD><EFBFBD><EFBFBD>д<EFBFBD><D0B4><EFBFBD><EFBFBD><EFBFBD>
|
||||
' If objSymbol.Value.IsBuiltIn Then
|
||||
' dim oldenv
|
||||
' set oldenv = objSymbol.Value.objEnv
|
||||
' Set objSymbol.Value.objEnv = objEnv
|
||||
' objSymbol.Value.objEnv.SetSelf objSymbol.Value.objEnv
|
||||
' objSymbol.Value.objEnv.SetOuter oldEnv
|
||||
' Set Evaluate = objSymbol.Value.Run(objCode)
|
||||
|
||||
' Else
|
||||
' Set Evaluate = objSymbol.Value.Run(EvaluateAST(objCode, objEnv))
|
||||
' End If
|
||||
' 'wsh.echo space(DEPTH*4)&"evaluate","type",Evaluate.Type
|
||||
' 'If Evaluate.Type = 7 Then wsh.echo space(DEPTH*4)&Evaluate.value
|
||||
' 'If Evaluate.Type = 8 Then wsh.echo space(DEPTH*4)&Evaluate.value
|
||||
' 'If Evaluate.Type = 0 Then wsh.echo space(DEPTH*4)&PrintMalType(Evaluate,True)
|
||||
' 'Set Evaluate = Evaluate(objCode, objEnv)
|
||||
' 'MsgBox Evaluate.type
|
||||
' 'MsgBox objEnv.Get("N").value
|
||||
' 'MsgBox 3
|
||||
' 'wsh.echo space(DEPTH*4)&"EVAL NORMAL FINISH"
|
||||
' End If
|
||||
' Else
|
||||
' 'wsh.echo space(DEPTH*4)&"objcode","type",objCode.Type
|
||||
' 'If objCode.Type = 7 Then wsh.echo space(DEPTH*4)&objCode.value
|
||||
' 'If objCode.Type = 8 Then wsh.echo space(DEPTH*4)&objCode.value
|
||||
' 'If objCode.Type = 0 Then wsh.echo space(DEPTH*4)&PrintMalType(objCode,True)
|
||||
' Set Evaluate = EvaluateAST(objCode, objEnv)
|
||||
' 'wsh.echo space(DEPTH*4)&"evaluate","type",Evaluate.Type
|
||||
' 'If Evaluate.Type = 7 Then wsh.echo space(DEPTH*4)&Evaluate.value
|
||||
' 'If Evaluate.Type = 8 Then wsh.echo space(DEPTH*4)&Evaluate.value
|
||||
' 'If Evaluate.Type = 0 Then wsh.echo space(DEPTH*4)&PrintMalType(Evaluate,True)
|
||||
' 'wsh.echo ""
|
||||
' End If
|
||||
' 'wsh.echo space(DEPTH*4)&"RETURN"
|
||||
' DEPTH = DEPTH - 1
|
||||
' End Function
|
||||
|
||||
' Class BuiltInFunction
|
||||
' Public IsBuiltIn
|
||||
' Public Sub Class_Initialize
|
||||
' IsBuiltIn = False
|
||||
' End Sub
|
||||
' Public Run
|
||||
' Public Sub SetEnv(z)
|
||||
' End Sub
|
||||
' End Class
|
||||
|
||||
' Class Lambda
|
||||
' Public objParameters
|
||||
' Public objBody
|
||||
' Public objEnv
|
||||
' Public IsBuiltIn
|
||||
' Public Sub Class_Initialize
|
||||
' IsBuiltIn = True
|
||||
' End Sub
|
||||
' Public Function SetEnv(oInv)
|
||||
' Set objEnv=oInv
|
||||
' End Function
|
||||
|
||||
' Public Function Run(objArgs)
|
||||
' Dim objNewEnv
|
||||
' Set objNewEnv = New Environment
|
||||
' objNewEnv.SetSelf objNewEnv
|
||||
' objNewEnv.SetOuter objEnv
|
||||
' 'MsgBox objArgs.type
|
||||
' objNewEnv.Init objParameters, objArgs
|
||||
' 'para start from 0, args start from 1
|
||||
' 'MsgBox objNewEnv.Get("N").value
|
||||
' 'wsh.echo space(DEPTH*4)&"RUN "& PrintMalType(objBody,True)
|
||||
' Set Run = Evaluate(objBody, objNewEnv)
|
||||
' 'wsh.echo space(DEPTH*4)&"RUN FINISH"
|
||||
' 'MsgBox Run.type
|
||||
' 'MsgBox Run.value
|
||||
' End Function
|
||||
' End Class
|
||||
|
||||
' Function IsZero(objMal)
|
||||
' IsZero = (objMal.Type = TYPE_NUMBER And objMal.Value = 0)
|
||||
' 'MsgBox IsZero
|
||||
' End Function
|
||||
|
||||
' Function IsFalse(objMal)
|
||||
' IsFalse = (objMal.Type = TYPE_BOOLEAN)
|
||||
' If Not IsFalse Then Exit Function
|
||||
' IsFalse = IsFalse And (objMal.Value = False)
|
||||
' End Function
|
||||
|
||||
' Function IsNil(objMal)
|
||||
' IsNil = (objMal.Type = TYPE_NIL)
|
||||
' End Function
|
||||
|
||||
' Sub CheckEven(lngNum)
|
||||
' If lngNum Mod 2 <> 0 Then
|
||||
' boolError = True
|
||||
' strError = "not a even number"
|
||||
' Call REPL()
|
||||
' End If
|
||||
' End Sub
|
||||
|
||||
' Sub CheckList(objMal)
|
||||
' If objMal.Type <> TYPE_LIST Then
|
||||
' boolError = True
|
||||
' strError = "neither a list nor a vector"
|
||||
' Call REPL()
|
||||
' End If
|
||||
' End Sub
|
||||
|
||||
' Sub CheckListOrVector(objMal)
|
||||
' If objMal.Type <> TYPE_LIST And objMal.Type <> TYPE_VECTOR Then
|
||||
' boolError = True
|
||||
' strError = "not a list"
|
||||
' Call REPL()
|
||||
' End If
|
||||
' End Sub
|
||||
|
||||
' Sub CheckSymbol(objMal)
|
||||
' If objMal.Type <> TYPE_SYMBOL Then
|
||||
' boolError = True
|
||||
' strError = "not a symbol"
|
||||
' Call REPL()
|
||||
' End If
|
||||
' End Sub
|
||||
|
||||
' Function EvaluateAST(objCode, objEnv)
|
||||
' If TypeName(objCode) = "Nothing" Then
|
||||
' MsgBox "Nothing2"
|
||||
' End If
|
||||
|
||||
' Dim objResult, i
|
||||
' Select Case objCode.Type
|
||||
' Case TYPE_SYMBOL
|
||||
' Set objResult = objEnv.Get(objCode.Value)
|
||||
' Case TYPE_LIST
|
||||
' Set objResult = New MalType
|
||||
' Set objResult.Value = CreateObject("System.Collections.ArrayList")
|
||||
' objResult.Type = TYPE_LIST
|
||||
' For i = 0 To objCode.Value.Count - 1
|
||||
' objResult.Value.Add Evaluate(objCode.Value.Item(i), objEnv)
|
||||
' Next
|
||||
' Case TYPE_VECTOR
|
||||
' Set objResult = New MalType
|
||||
' Set objResult.Value = CreateObject("System.Collections.ArrayList")
|
||||
' objResult.Type = TYPE_VECTOR
|
||||
' For i = 0 To objCode.Value.Count - 1
|
||||
' objResult.Value.Add Evaluate(objCode.Value.Item(i), objEnv)
|
||||
' Next
|
||||
' Case TYPE_HASHMAP
|
||||
' Set objResult = New MalType
|
||||
' Set objResult.Value = CreateObject("Scripting.Dictionary")
|
||||
' objResult.Type = TYPE_HASHMAP
|
||||
' Dim key
|
||||
' For Each key In objCode.Value.Keys
|
||||
' objResult.Value.Add Evaluate(key, objEnv), Evaluate(objCode.Value.Item(key), objEnv)
|
||||
' Next
|
||||
' Case Else
|
||||
' Set objResult = objCode
|
||||
' End Select
|
||||
' Set EvaluateAST = objResult
|
||||
' End Function
|
||||
|
||||
' Function Print(objCode)
|
||||
' Print = PrintMalType(objCode, True)
|
||||
' End Function
|
||||
|
||||
' Function REP(strCode)
|
||||
' REP = Print(Evaluate(Read(strCode), objRootEnv))
|
||||
' End Function
|
||||
|
||||
' Sub Include(strFileName)
|
||||
' With CreateObject("Scripting.FileSystemObject")
|
||||
' ExecuteGlobal .OpenTextFile( _
|
||||
' .GetParentFolderName( _
|
||||
' .GetFile(WScript.ScriptFullName)) & _
|
||||
' "\" & strFileName).ReadAll
|
||||
' End With
|
||||
' End Sub
|
||||
End Sub
|
||||
@ -281,6 +281,7 @@ Class MalProcedure 'Extends MalType
|
||||
i = i + 1
|
||||
End If
|
||||
Wend
|
||||
|
||||
Set varRet = Evaluate(objCode, objNewEnv)
|
||||
Set Apply = varRet
|
||||
End Function
|
||||
|
||||
Loading…
Reference in New Issue
Block a user