From c283a469c0cd14b488f1d10553f460e2ee46a381 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Mon, 10 Jan 2022 00:07:07 +0800 Subject: [PATCH 001/129] vbs: batch impl init --- impls/batch/reader.bat | 64 +++++++++++++++++++++ impls/batch/step0_repl.bat | 112 +++++++++++++++++++++++++++++++++++++ 2 files changed, 176 insertions(+) create mode 100644 impls/batch/reader.bat create mode 100644 impls/batch/step0_repl.bat diff --git a/impls/batch/reader.bat b/impls/batch/reader.bat new file mode 100644 index 0000000000..20d432fbca --- /dev/null +++ b/impls/batch/reader.bat @@ -0,0 +1,64 @@ +:: Code by OldLiu +:: using batch to achieve this program is a big challenge, but I still done it. +:: I hope you like it, lol. + + +::Start + Set "_TMP_Arguments_=%*" + If "!_TMP_Arguments_:~,1!" Equ ":" ( + Set "_TMP_Arguments_=!_TMP_Arguments_:~1!" + ) + Call :!_TMP_Arguments_! + Set _TMP_Arguments_= +Goto :Eof + +:read_str + setlocal + for %%a in ("!re!") do ( + endlocal + set "re=%%~a" + ) +goto :eof + + +:read_form code + setlocal + set "code=%~1" + call :_delete_space code + if "!code:~,1!" == "(" ( + call :read_list "!code:~1!" + ) else ( + call :read_atom "!code:~1!" + ) + for %%a in ("!re!") do ( + endlocal + set "re=%%~a" + ) +goto :eof + +:read_list code + setlocal + set "code=%~1" + call :_delete_space code + for %%a in ("!re!") do ( + endlocal + set "re=%%~a" + ) +goto :eof + +:read_atom code + setlocal + set "code=%~1" + call :_delete_space code + for %%a in ("!re!") do ( + endlocal + set "re=%%~a" + ) +goto :eof + +:_delete_space var + if "!%1:~,1!" == " " ( + set "%1=!%1:~1!" + goto :_delete_space + ) +goto :eof \ No newline at end of file diff --git a/impls/batch/step0_repl.bat b/impls/batch/step0_repl.bat new file mode 100644 index 0000000000..223b305b4b --- /dev/null +++ b/impls/batch/step0_repl.bat @@ -0,0 +1,112 @@ +:: Code by OldLiu +:: using batch to achieve this program is a big challenge, but I still done it. +:: I hope you like it, lol. + +@echo off +setlocal disabledelayedexpansion +for /f "delims==" %%a in ('set') do set "%%a=" + +:main + set input= + set /p "input=user> " + if defined input ( + rem first replace double quotation mark. + set "input=%input:"=This_is_a_double_quotation_mark,lol%" + rem Batch can't deal with "!" when delayed expansion is enabled, so replace it to a special string. + call set "input=%%input:!=This_is_a_Exclamation_Mark,lol%%" + setlocal ENABLEDELAYEDEXPANSION + %improve speed start% ( + rem Batch has some proble in "^" processing, so replace it. + set "input=!input:^=This_is_a_caret,lol!" + rem replace %. + set input_formated= + rem set input + :replacement_loop + if defined input ( + if "!input:~,1!" == "%%" ( + set "input_formated=!input_formated!This_is_a_percent_symbol,lol" + ) else ( + set "input_formated=!input_formated!!input:~,1!" + ) + set "input=!input:~1!" + goto replacement_loop + ) + rem set input + call :rep "!input_formated!" + endlocal + ) %improve speed end% + ) +goto :main + + +%improve speed start% ( + :READ + setlocal + rem re means return, which bring return value. + set "re=%~1" + for /f "delims=" %%a in ("!re!") do ( + endlocal + set "re=%%~a" + ) + goto :eof + + :EVAL + setlocal + set "re=%~1" + for /f "delims=" %%a in ("!re!") do ( + endlocal + set "re=%%~a" + ) + goto :eof + + :PRINT + setlocal + set "output=%~1" + rem replace all speical symbol back. + set output_buffer= + :output_loop + if "!output:~,30!" == "This_is_a_Exclamation_Mark,lol" ( + set "output_buffer=!output_buffer!^!" + set "output=!output:~30!" + goto output_loop + ) else if "!output:~,19!" == "This_is_a_caret,lol" ( + set "output_buffer=!output_buffer!^^" + set "output=!output:~19!" + goto output_loop + ) else if "!output:~,35!" == "This_is_a_double_quotation_mark,lol" ( + set "output_buffer=!output_buffer!^"" + set "output=!output:~35!" + goto output_loop + ) else if "!output:~,1!" == "=" ( + set "output_buffer=!output_buffer!=" + set "output=!output:~1!" + goto output_loop + ) else if "!output:~,1!" == " " ( + set "output_buffer=!output_buffer! " + set "output=!output:~1!" + goto output_loop + ) else if "!output:~,28!" == "This_is_a_percent_symbol,lol" ( + set "output_buffer=!output_buffer!%%" + set "output=!output:~28!" + goto output_loop + ) else if defined output ( + set "output_buffer=!output_buffer!!output:~,1!" + set "output=!output:~1!" + goto output_loop + ) + echo.!output_buffer! + set "re=%~1" + for /f "delims=" %%a in ("!re!") do ( + endlocal + set "re=%%~a" + ) + goto :eof + + :rep + setlocal + call :READ "%~1" + call :EVAL "!re!" + call :PRINT "!re!" + endlocal + goto :eof +) %improve speed end% \ No newline at end of file From d3fbaf76da5fc6a7b31e7c9ef22143de2f71cb7c Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Thu, 17 Feb 2022 23:02:57 +0800 Subject: [PATCH 002/129] vbs: vbs step 0&1 --- impls/batch/reader.bat | 64 ------------------- impls/batch/step0_repl.bat | 112 --------------------------------- impls/vbs/printer.vbs | 25 ++++++++ impls/vbs/reader.vbs | 65 +++++++++++++++++++ impls/vbs/step0_repl.vbs | 21 +++++++ impls/vbs/step1_read_print.vbs | 36 +++++++++++ 6 files changed, 147 insertions(+), 176 deletions(-) delete mode 100644 impls/batch/reader.bat delete mode 100644 impls/batch/step0_repl.bat create mode 100644 impls/vbs/printer.vbs create mode 100644 impls/vbs/reader.vbs create mode 100644 impls/vbs/step0_repl.vbs create mode 100644 impls/vbs/step1_read_print.vbs diff --git a/impls/batch/reader.bat b/impls/batch/reader.bat deleted file mode 100644 index 20d432fbca..0000000000 --- a/impls/batch/reader.bat +++ /dev/null @@ -1,64 +0,0 @@ -:: Code by OldLiu -:: using batch to achieve this program is a big challenge, but I still done it. -:: I hope you like it, lol. - - -::Start - Set "_TMP_Arguments_=%*" - If "!_TMP_Arguments_:~,1!" Equ ":" ( - Set "_TMP_Arguments_=!_TMP_Arguments_:~1!" - ) - Call :!_TMP_Arguments_! - Set _TMP_Arguments_= -Goto :Eof - -:read_str - setlocal - for %%a in ("!re!") do ( - endlocal - set "re=%%~a" - ) -goto :eof - - -:read_form code - setlocal - set "code=%~1" - call :_delete_space code - if "!code:~,1!" == "(" ( - call :read_list "!code:~1!" - ) else ( - call :read_atom "!code:~1!" - ) - for %%a in ("!re!") do ( - endlocal - set "re=%%~a" - ) -goto :eof - -:read_list code - setlocal - set "code=%~1" - call :_delete_space code - for %%a in ("!re!") do ( - endlocal - set "re=%%~a" - ) -goto :eof - -:read_atom code - setlocal - set "code=%~1" - call :_delete_space code - for %%a in ("!re!") do ( - endlocal - set "re=%%~a" - ) -goto :eof - -:_delete_space var - if "!%1:~,1!" == " " ( - set "%1=!%1:~1!" - goto :_delete_space - ) -goto :eof \ No newline at end of file diff --git a/impls/batch/step0_repl.bat b/impls/batch/step0_repl.bat deleted file mode 100644 index 223b305b4b..0000000000 --- a/impls/batch/step0_repl.bat +++ /dev/null @@ -1,112 +0,0 @@ -:: Code by OldLiu -:: using batch to achieve this program is a big challenge, but I still done it. -:: I hope you like it, lol. - -@echo off -setlocal disabledelayedexpansion -for /f "delims==" %%a in ('set') do set "%%a=" - -:main - set input= - set /p "input=user> " - if defined input ( - rem first replace double quotation mark. - set "input=%input:"=This_is_a_double_quotation_mark,lol%" - rem Batch can't deal with "!" when delayed expansion is enabled, so replace it to a special string. - call set "input=%%input:!=This_is_a_Exclamation_Mark,lol%%" - setlocal ENABLEDELAYEDEXPANSION - %improve speed start% ( - rem Batch has some proble in "^" processing, so replace it. - set "input=!input:^=This_is_a_caret,lol!" - rem replace %. - set input_formated= - rem set input - :replacement_loop - if defined input ( - if "!input:~,1!" == "%%" ( - set "input_formated=!input_formated!This_is_a_percent_symbol,lol" - ) else ( - set "input_formated=!input_formated!!input:~,1!" - ) - set "input=!input:~1!" - goto replacement_loop - ) - rem set input - call :rep "!input_formated!" - endlocal - ) %improve speed end% - ) -goto :main - - -%improve speed start% ( - :READ - setlocal - rem re means return, which bring return value. - set "re=%~1" - for /f "delims=" %%a in ("!re!") do ( - endlocal - set "re=%%~a" - ) - goto :eof - - :EVAL - setlocal - set "re=%~1" - for /f "delims=" %%a in ("!re!") do ( - endlocal - set "re=%%~a" - ) - goto :eof - - :PRINT - setlocal - set "output=%~1" - rem replace all speical symbol back. - set output_buffer= - :output_loop - if "!output:~,30!" == "This_is_a_Exclamation_Mark,lol" ( - set "output_buffer=!output_buffer!^!" - set "output=!output:~30!" - goto output_loop - ) else if "!output:~,19!" == "This_is_a_caret,lol" ( - set "output_buffer=!output_buffer!^^" - set "output=!output:~19!" - goto output_loop - ) else if "!output:~,35!" == "This_is_a_double_quotation_mark,lol" ( - set "output_buffer=!output_buffer!^"" - set "output=!output:~35!" - goto output_loop - ) else if "!output:~,1!" == "=" ( - set "output_buffer=!output_buffer!=" - set "output=!output:~1!" - goto output_loop - ) else if "!output:~,1!" == " " ( - set "output_buffer=!output_buffer! " - set "output=!output:~1!" - goto output_loop - ) else if "!output:~,28!" == "This_is_a_percent_symbol,lol" ( - set "output_buffer=!output_buffer!%%" - set "output=!output:~28!" - goto output_loop - ) else if defined output ( - set "output_buffer=!output_buffer!!output:~,1!" - set "output=!output:~1!" - goto output_loop - ) - echo.!output_buffer! - set "re=%~1" - for /f "delims=" %%a in ("!re!") do ( - endlocal - set "re=%%~a" - ) - goto :eof - - :rep - setlocal - call :READ "%~1" - call :EVAL "!re!" - call :PRINT "!re!" - endlocal - goto :eof -) %improve speed end% \ No newline at end of file diff --git a/impls/vbs/printer.vbs b/impls/vbs/printer.vbs new file mode 100644 index 0000000000..505aa2981c --- /dev/null +++ b/impls/vbs/printer.vbs @@ -0,0 +1,25 @@ +Function pr_str(o) + If typename(o) = "ArrayList" Then + pr_str ="(" + bool = False + For Each item In o + bool = True + pr_str =pr_str & pr_str(item) & " " + Next + if bool then + pr_str = left(pr_str,len(pr_str)-1) & ")" + else + pr_str = "()" + End If + Else + pr_str = o.value_ + End If +End Function + + +' set list = CreateObject("System.Collections.ArrayList") +' list.add(3) +' for each i in list +' msgbox i +' next + diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs new file mode 100644 index 0000000000..0c2a14b6e3 --- /dev/null +++ b/impls/vbs/reader.vbs @@ -0,0 +1,65 @@ +Class MalType + Public Type_ + Public value_ +End Class + + +'msgbox pr_str(read_str("(123 (456, 567))")) +'msgbox typename(CreateObject("System.Collections.ArrayList")) + +Function read_str(str) + set read_str=read_form(tokenize(str)) +End Function + +Function tokenize(str) + Set oQueue = CreateObject("System.Collections.Queue") + Set regEx = New RegExp + regEx.Pattern = "[\s,]*(~@|[\[\]{}()'`~^@]|""(?:\\.|[^\\""])*""?|;.*|[^\s\[\]{}('""`,;)]*)" + regEx.IgnoreCase = True + regEx.Global = True + Set Matches = regEx.Execute(str) + For Each Match In Matches + 'msgbox Match.SubMatches(0) + oQueue.Enqueue(Match.SubMatches(0)) + Next + Set regEx = Nothing + Set Matches = Nothing + Set tokenize = oQueue +End Function + +Function read_form(oQueue) + If oQueue.Peek() = "(" Then + set read_form = read_list(oQueue) + Else + set read_form = read_atom(oQueue) + End If +End Function + +Function read_list(oQueue) + oQueue.Dequeue() + + set read_list = CreateObject("System.Collections.ArrayList") + + While oQueue.count <> 0 And oQueue.Peek() <> ")" + read_list.Add read_form(oQueue) + Wend + If oQueue.count <> 0 Then + oQueue.Dequeue() + End If +End Function + +Function read_atom(oQueue) + atom = oQueue.Dequeue() + if isnumeric(atom) Then + set read_atom = new MalType + read_atom.Type_ = "number" + read_atom.value_ = atom + else + set read_atom = new MalType + read_atom.Type_ = "symbol" + read_atom.value_ = atom + End If +End Function + + +'msgbox pr_str(read_str("1")) \ No newline at end of file diff --git a/impls/vbs/step0_repl.vbs b/impls/vbs/step0_repl.vbs new file mode 100644 index 0000000000..4143b3e3e0 --- /dev/null +++ b/impls/vbs/step0_repl.vbs @@ -0,0 +1,21 @@ +Function READ(str) + READ = str +End Function + +Function EVAL(str) + EVAL = str +End Function + +Function PRINT(str) + PRINT = str +End Function + +Function rep(str) + rep = PRINT(EVAL(READ(str))) +End Function + +While True + WScript.StdOut.Write("user> ") + code = WScript.StdIn.ReadLine() + WScript.Echo(rep(code)) +WEnd diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs new file mode 100644 index 0000000000..bc592b054d --- /dev/null +++ b/impls/vbs/step1_read_print.vbs @@ -0,0 +1,36 @@ +Include "reader.vbs" +Include "printer.vbs" + +Function READ(str) + set READ = read_str(str) +End Function + +Function EVAL(oMal) + set EVAL = oMal +End Function + +Function PRINT(oMal) + PRINT = pr_str(oMal) +End Function + +Function rep(str) + rep = PRINT(EVAL(READ(str))) +End Function + +While True + WScript.StdOut.Write("user> ") + code = WScript.StdIn.ReadLine() + WScript.Echo(rep(code)) +WEnd + +Sub Include(sInstFile) + Dim oFSO, f, s + Set oFSO = CreateObject("Scripting.FileSystemObject") + sInstFile = oFSO.GetParentFolderName(oFSO.GetFile(Wscript.ScriptFullName)) & "\" & sInstFile + Set f = oFSO.OpenTextFile(sInstFile) + s = f.ReadAll + f.Close + Set f = Nothing + Set oFSO = Nothing + ExecuteGlobal s +End Sub \ No newline at end of file From ae38ddf2f45fb34e4f7921401143eb3b8de0b215 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 17 Feb 2022 23:04:40 +0800 Subject: [PATCH 003/129] vbs: Merge branch 'kanaka:master' into master From e3f6a8f0f49b42df1ff9e07390bc4bd5d2d5869b Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Fri, 18 Feb 2022 12:00:05 +0800 Subject: [PATCH 004/129] vbs: add error handling,macros, string, boolean, null --- impls/vbs/printer.vbs | 31 +++++----- impls/vbs/reader.vbs | 106 ++++++++++++++++++++++++++++++--- impls/vbs/step1_read_print.vbs | 5 +- 3 files changed, 118 insertions(+), 24 deletions(-) diff --git a/impls/vbs/printer.vbs b/impls/vbs/printer.vbs index 505aa2981c..a69d5c908c 100644 --- a/impls/vbs/printer.vbs +++ b/impls/vbs/printer.vbs @@ -1,19 +1,22 @@ -Function pr_str(o) - If typename(o) = "ArrayList" Then - pr_str ="(" - bool = False - For Each item In o - bool = True - pr_str =pr_str & pr_str(item) & " " - Next - if bool then - pr_str = left(pr_str,len(pr_str)-1) & ")" - else - pr_str = "()" +Function pr_str(o,print_readably) + if not print_readably then + If left(o.type_,4) = "list" Then + pr_str =mid(o.type_,5,1) + bool = False + For Each item In o.value_ + bool = True + pr_str =pr_str & pr_str(item,print_readably) & " " + Next + if bool then + pr_str = left(pr_str,len(pr_str)-1) & mid(o.type_,6,1) + else + pr_str = mid(o.type_,5,2) + End If + Else + pr_str = o.value_ End If Else - pr_str = o.value_ - End If + end if End Function diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs index 0c2a14b6e3..33a0814cb5 100644 --- a/impls/vbs/reader.vbs +++ b/impls/vbs/reader.vbs @@ -20,7 +20,9 @@ Function tokenize(str) Set Matches = regEx.Execute(str) For Each Match In Matches 'msgbox Match.SubMatches(0) - oQueue.Enqueue(Match.SubMatches(0)) + if not left(Match.SubMatches(0), 1) = ";" then + oQueue.Enqueue(Match.SubMatches(0)) + End if Next Set regEx = Nothing Set Matches = Nothing @@ -28,23 +30,74 @@ Function tokenize(str) End Function Function read_form(oQueue) - If oQueue.Peek() = "(" Then + if oQueue.Count = 0 then + Set read_form = Nothing + exit function + end if + If oQueue.Peek() = "(" or oQueue.Peek() = "[" or oQueue.Peek() = "{" Then set read_form = read_list(oQueue) + elseif oQueue.Peek() = "'" or oQueue.Peek() = "`" or oQueue.Peek() = "~" or oQueue.Peek() = "~@" or oQueue.Peek = "@" then + select case oQueue.Dequeue() + case "'" + s = "quote" + case "`" + s = "quasiquote" + case "~" + s = "unquote" + case "~@" + s = "splice-unquote" + case "@" + s = "deref" + end select + set o = new MalType + o.Type_ = "symbol" + o.value_ = s + set l = new MalType + l.Type_ = "list()" + set l.value_ = CreateObject("System.Collections.ArrayList") + l.value_.Add(o) + l.value_.Add(read_form(oQueue)) + set read_form = l + elseif oQueue.Peek() = ")" or oQueue.Peek() = "]" or oQueue.Peek() = "}" then + Set read_form = Nothing + err.Raise vbObjectError, "read_form", "unbalanced parentheses" + elseif oQueue.Peek() = "^" then + oQueue.Dequeue() + set o = new MalType + o.Type_ = "symbol" + o.value_ = "with-meta" + set l = new MalType + l.Type_ = "list()" + set l.value_ = CreateObject("System.Collections.ArrayList") + l.value_.Add(o) + set tmp = read_form(oQueue) + l.value_.Add(read_form(oQueue)) + l.value_.Add(tmp) + set read_form = l Else set read_form = read_atom(oQueue) End If End Function Function read_list(oQueue) - oQueue.Dequeue() + p = oQueue.Dequeue() + if p = "(" Then + q = ")" + elseif p = "[" then + q = "]" + elseif p = "{" then + q = "}" + end if - set read_list = CreateObject("System.Collections.ArrayList") + set read_list = new MalType + set read_list.value_ = CreateObject("System.Collections.ArrayList") + read_list.type_ = "list"+p+q - While oQueue.count <> 0 And oQueue.Peek() <> ")" - read_list.Add read_form(oQueue) + While oQueue.count > 1 And oQueue.Peek() <> q + read_list.value_.Add read_form(oQueue) Wend - If oQueue.count <> 0 Then - oQueue.Dequeue() + If oQueue.Dequeue() <> q Then + err.raise vbObjectError,"reader", "excepted '"+q+"', got EOF" End If End Function @@ -54,6 +107,42 @@ Function read_atom(oQueue) set read_atom = new MalType read_atom.Type_ = "number" read_atom.value_ = atom + elseif atom = "true" or atom = "false" Then + set read_atom = new MalType + read_atom.Type_ = "boolean" + read_atom.value_ = atom + elseif left(atom,1) = """" Then + if (not right(atom,1) = """") or len(atom) = 1 then err.raise vbObjectError,"reader", "Unterminated string" + set read_atom = new MalType + read_atom.Type_ = "string" + str_tmp = "" + for i = 2 to len(atom) - 1 + if backslash then + backslash = False + 'msgbox backslash + if mid(atom,i,1) = "n" then + str_tmp = str_tmp + vbnewline + elseif mid(atom,i,1) = "\" then + str_tmp = str_tmp + "\" + elseif mid(atom,i,1) = """" then + str_tmp = str_tmp + """" + end if + else + if mid(atom,i,1) = "\" then + backslash = True + else + str_tmp = str_tmp + mid(atom,i,1) + end if + end if + next + if backslash then err.raise vbObjectError,"reader", "Unterminated string" + read_atom.value_ = """" + str_tmp + """" + elseif atom = "nil" Then + set read_atom = new MalType + read_atom.Type_ = "null" + read_atom.value_ = atom + elseif left(atom,1) = ";" Then + set read_atom = nothing else set read_atom = new MalType read_atom.Type_ = "symbol" @@ -62,4 +151,3 @@ Function read_atom(oQueue) End Function -'msgbox pr_str(read_str("1")) \ No newline at end of file diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index bc592b054d..3e47f792c0 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -10,11 +10,14 @@ Function EVAL(oMal) End Function Function PRINT(oMal) - PRINT = pr_str(oMal) + PRINT = pr_str(oMal,false) End Function Function rep(str) + on error resume next rep = PRINT(EVAL(READ(str))) + if err.number <> 0 then rep = err.description + on error goto 0 End Function While True From 33a826adb906feef60f1a0a21bf33080de1f4c83 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Fri, 18 Feb 2022 12:14:44 +0800 Subject: [PATCH 005/129] vbs: add extra code data detect --- impls/vbs/reader.vbs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs index 33a0814cb5..e2c5287af2 100644 --- a/impls/vbs/reader.vbs +++ b/impls/vbs/reader.vbs @@ -8,7 +8,7 @@ End Class 'msgbox typename(CreateObject("System.Collections.ArrayList")) Function read_str(str) - set read_str=read_form(tokenize(str)) + set read_str=read_form_(tokenize(str)) End Function Function tokenize(str) @@ -29,6 +29,13 @@ Function tokenize(str) Set tokenize = oQueue End Function +Function read_form_(oQueue) + set read_form_=read_form(oQueue) + if oQueue.Count > 0 then + err.raise vbObjectError,"SyntaxError", "Extra data after form: " + oQueue.Dequeue + end if +End Function + Function read_form(oQueue) if oQueue.Count = 0 then Set read_form = Nothing @@ -77,6 +84,7 @@ Function read_form(oQueue) Else set read_form = read_atom(oQueue) End If + End Function Function read_list(oQueue) @@ -99,6 +107,7 @@ Function read_list(oQueue) If oQueue.Dequeue() <> q Then err.raise vbObjectError,"reader", "excepted '"+q+"', got EOF" End If + 'msgbox oQueue.peek End Function Function read_atom(oQueue) From 07740dde690f4a62565aa93f281be8f104bde512 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sat, 26 Feb 2022 10:52:44 +0800 Subject: [PATCH 006/129] vbs: fix hashtable, string, error handle --- impls/vbs/printer.vbs | 52 +++++++++++++++++++++---------- impls/vbs/reader.vbs | 56 ++++++++++++++++++++++++++++++---- impls/vbs/step1_read_print.vbs | 2 +- 3 files changed, 87 insertions(+), 23 deletions(-) diff --git a/impls/vbs/printer.vbs b/impls/vbs/printer.vbs index a69d5c908c..a10511b4bf 100644 --- a/impls/vbs/printer.vbs +++ b/impls/vbs/printer.vbs @@ -1,22 +1,42 @@ Function pr_str(o,print_readably) - if not print_readably then - If left(o.type_,4) = "list" Then - pr_str =mid(o.type_,5,1) - bool = False - For Each item In o.value_ - bool = True - pr_str =pr_str & pr_str(item,print_readably) & " " - Next - if bool then - pr_str = left(pr_str,len(pr_str)-1) & mid(o.type_,6,1) - else - pr_str = mid(o.type_,5,2) - End If - Else - pr_str = o.value_ + If left(o.type_,4) = "list" Then + pr_str =mid(o.type_,5,1) + bool = False + For Each item In o.value_ + bool = True + pr_str =pr_str & pr_str(item,print_readably) & " " + Next + if bool then + pr_str = left(pr_str,len(pr_str)-1) & mid(o.type_,6,1) + else + pr_str = mid(o.type_,5,2) + End If + elseif o.type_ = "hash-map" Then + pr_str = "{" + bool = False + For each item in o.value_ + bool = True + pr_str =pr_str & pr_str(item,print_readably) & " " & pr_str(o.value_.item(item),print_readably) & " " + Next + if bool then + pr_str = left(pr_str,len(pr_str)-1) & "}" + else + pr_str = "{}" End If Else - end if + if print_readably and o.type_="string" then + pr_str = o.value_ + pr_str = replace(pr_str,"\","\\") + pr_str = replace(pr_str,vbnewline,"\n") + pr_str = replace(pr_str,"""","\""") + pr_str = """" & pr_str & """" + Elseif o.type_="string" then + pr_str = """" & o.value_ & """" + else + pr_str = o.value_ + End If + End If + End Function diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs index e2c5287af2..906f6f334a 100644 --- a/impls/vbs/reader.vbs +++ b/impls/vbs/reader.vbs @@ -1,3 +1,5 @@ +Include "printer.vbs" + Class MalType Public Type_ Public value_ @@ -6,9 +8,9 @@ End Class 'msgbox pr_str(read_str("(123 (456, 567))")) 'msgbox typename(CreateObject("System.Collections.ArrayList")) - +'msgbox pr_str(read_str("(123 ")) Function read_str(str) - set read_str=read_form_(tokenize(str)) + set read_str=read_form(tokenize(str)) End Function Function tokenize(str) @@ -42,7 +44,13 @@ Function read_form(oQueue) exit function end if If oQueue.Peek() = "(" or oQueue.Peek() = "[" or oQueue.Peek() = "{" Then - set read_form = read_list(oQueue) + if oQueue.Peek() = "(" then + Set read_form = read_list(oQueue) + elseif oQueue.Peek() = "[" then + Set read_form = read_vector(oQueue) + elseif oQueue.Peek() = "{" then + Set read_form = read_hash_map(oQueue) + end if elseif oQueue.Peek() = "'" or oQueue.Peek() = "`" or oQueue.Peek() = "~" or oQueue.Peek() = "~@" or oQueue.Peek = "@" then select case oQueue.Dequeue() case "'" @@ -110,6 +118,27 @@ Function read_list(oQueue) 'msgbox oQueue.peek End Function +function read_vector(oQueue) + set read_vector = read_list(oQueue) +end function + +function read_hash_map(oQueue) + oQueue.Dequeue() + set read_hash_map = new MalType + set read_hash_map.value_ = CreateObject("Scripting.Dictionary") + + read_hash_map.type_ = "hash-map" + While oQueue.count > 1 And oQueue.Peek() <> "}" + set key = read_form(oQueue) + read_hash_map.value_.Add key, read_form(oQueue) + Wend + If oQueue.Dequeue() <> "}" Then + err.raise vbObjectError,"reader", "excepted '}', got EOF" + End If +End Function + + + Function read_atom(oQueue) atom = oQueue.Dequeue() if isnumeric(atom) Then @@ -121,7 +150,7 @@ Function read_atom(oQueue) read_atom.Type_ = "boolean" read_atom.value_ = atom elseif left(atom,1) = """" Then - if (not right(atom,1) = """") or len(atom) = 1 then err.raise vbObjectError,"reader", "Unterminated string" + if (not right(atom,1) = """") or len(atom) = 1 then err.raise vbObjectError,"reader", "Unterminated string, got EOF" set read_atom = new MalType read_atom.Type_ = "string" str_tmp = "" @@ -144,12 +173,16 @@ Function read_atom(oQueue) end if end if next - if backslash then err.raise vbObjectError,"reader", "Unterminated string" - read_atom.value_ = """" + str_tmp + """" + if backslash then err.raise vbObjectError,"reader", "Unterminated string, got EOF" + read_atom.value_ = str_tmp elseif atom = "nil" Then set read_atom = new MalType read_atom.Type_ = "null" read_atom.value_ = atom + elseif left(atom,1) = ":" Then + set read_atom = new MalType + read_atom.Type_ = "keyword" + read_atom.value_ = atom elseif left(atom,1) = ";" Then set read_atom = nothing else @@ -160,3 +193,14 @@ Function read_atom(oQueue) End Function +Sub Include(sInstFile) + Dim oFSO, f, s + Set oFSO = CreateObject("Scripting.FileSystemObject") + sInstFile = oFSO.GetParentFolderName(oFSO.GetFile(Wscript.ScriptFullName)) & "\" & sInstFile + Set f = oFSO.OpenTextFile(sInstFile) + s = f.ReadAll + f.Close + Set f = Nothing + Set oFSO = Nothing + ExecuteGlobal s +End Sub \ No newline at end of file diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index 3e47f792c0..00fb020e33 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -10,7 +10,7 @@ Function EVAL(oMal) End Function Function PRINT(oMal) - PRINT = pr_str(oMal,false) + PRINT = pr_str(oMal,true) End Function Function rep(str) From d8916d68524ffc1ba116238832f9cc58a3da7dab Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Mon, 2 May 2022 10:52:27 +0800 Subject: [PATCH 007/129] vbs: finish step2 --- impls/vbs/printer.vbs | 5 ++ impls/vbs/reader.vbs | 9 ++- impls/vbs/step2_eval.vbs | 140 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 152 insertions(+), 2 deletions(-) create mode 100644 impls/vbs/step2_eval.vbs diff --git a/impls/vbs/printer.vbs b/impls/vbs/printer.vbs index a10511b4bf..d0a818dfa6 100644 --- a/impls/vbs/printer.vbs +++ b/impls/vbs/printer.vbs @@ -1,4 +1,9 @@ Function pr_str(o,print_readably) + msgbox typename(o) = "Nothing" + if typename(o) = "Nothing" then + pr_str = "" + exit function + end if If left(o.type_,4) = "list" Then pr_str =mid(o.type_,5,1) bool = False diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs index 906f6f334a..71173a6d5f 100644 --- a/impls/vbs/reader.vbs +++ b/impls/vbs/reader.vbs @@ -11,6 +11,7 @@ End Class 'msgbox pr_str(read_str("(123 ")) Function read_str(str) set read_str=read_form(tokenize(str)) + 'msgbox pr_str(read_str,true) End Function Function tokenize(str) @@ -33,6 +34,7 @@ End Function Function read_form_(oQueue) set read_form_=read_form(oQueue) + 'msgbox pr_str(read_form_),true if oQueue.Count > 0 then err.raise vbObjectError,"SyntaxError", "Extra data after form: " + oQueue.Dequeue end if @@ -141,10 +143,13 @@ End Function Function read_atom(oQueue) atom = oQueue.Dequeue() - if isnumeric(atom) Then + if atom = "" then + set read_atom = Nothing + elseif isnumeric(atom) Then set read_atom = new MalType read_atom.Type_ = "number" - read_atom.value_ = atom + read_atom.value_ = cdbl(atom) + 'msgbox "here" elseif atom = "true" or atom = "false" Then set read_atom = new MalType read_atom.Type_ = "boolean" diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs new file mode 100644 index 0000000000..a50ad4c4dc --- /dev/null +++ b/impls/vbs/step2_eval.vbs @@ -0,0 +1,140 @@ +Include "reader.vbs" +Include "printer.vbs" + +function add(args) + set add = new MalType + add.type_ = "number" + 'msgbox typename(args) + add.value_ = args.value_.item(1).value_ + args.value_.item(2).value_ +end function + +function subtract(args) + set subtract = new MalType + subtract.type_ = "number" + subtract.value_ = args.value_.item(1).value_ - args.value_.item(2).value_ +end function + +function multiply(args) + set multiply = new MalType + multiply.type_ = "number" + multiply.value_ = args.value_.item(1).value_ * args.value_.item(2).value_ +end function + +function divide(args) + set divide = new MalType + divide.type_ = "number" + divide.value_ = args.value_.item(1).value_ / args.value_.item(2).value_ +end function + +function donothing(args) + set donothing = new MalType + donothing.type_ = "nil" + donothing.value_ = "error" +end function + +class enviroment + public env + private sub Class_Initialize() + set env = CreateObject("Scripting.Dictionary") + env.add "+",getref("add") + env.add "-",getref("subtract") + env.add "*",getref("multiply") + env.add "/",getref("divide") + env.add "donothing", getref("donothing") + end sub + +end class + +Function READ(str) + set READ = read_str(str) +End Function + +Function EVAL(oMal,env) + 'msgbox typename(o) + if isempty(o) then + set EVAL = donothing("") + exit function + end if + select case oMal.type_ + case "list()" + if oMal.value_.count = 0 then + set EVAL = oMal + else + 'wsh.echo oMal.value_.item(0).value_ + 'wsh.echo typename(env.env) + 'msgbox eval_ast(oMal.value_.item(1),env).value_ + 'msgbox typename(env.env.item("+")(oMal)) + 'if not isempty(oMal.value_.item(0)) then + set EVAL = env.env.item(eval_ast(oMal.value_.item(0),env).value_)(eval_ast(oMal,env)) + 'else + 'end if + end if + case else + set EVAL = eval_ast(oMal,env) + end select +End Function + +function eval_ast(ast,env) + select case ast.type_ + case "list()" + for i = 0 to ast.value_.count - 1 + set ast.value_.item(i) = EVAL(ast.value_.item(i),env) + next + set eval_ast = ast + case "symbol" + if env.env.Exists(ast.value_) then + set eval_ast = ast + else + 'err.raise vbObjectError, "eval_ast", "undefined symbol: " & ast.value_ + wsh.echo "undefined symbol: " & ast.value_ + ast.value_ = "donothing" + set eval_ast = ast + end if + case "list[]" + for i = 0 to ast.value_.count - 1 + set ast.value_.item(i) = EVAL(ast.value_.item(i),env) + next + set eval_ast = ast + case "hash-map" + For i = 0 To ast.value_.Count -1 ' 迭代数组。 + ' wsh.echo ast.value_.keys()(i).value_ + ' wsh.echo ast.value_.item(ast.value_.keys()(i)).value_ + set ast.value_.item(ast.value_.keys()(i)) = EVAL(ast.value_.item(ast.value_.keys()(i)),env) + Next + set eval_ast = ast + case else + set eval_ast = ast + end select +end function + + +Function PRINT(oMal) + PRINT = pr_str(oMal,true) +End Function + +Function rep(str,env) + 'on error resume next + rep = PRINT(EVAL(READ(str),env)) + 'msgbox 2 + if err.number <> 0 then rep = err.description + on error goto 0 +End Function + +While True + WScript.StdOut.Write("user> ") + code = WScript.StdIn.ReadLine() + set env = new enviroment + WScript.Echo(rep(code,env)) +WEnd + +Sub Include(sInstFile) + Dim oFSO, f, s + Set oFSO = CreateObject("Scripting.FileSystemObject") + sInstFile = oFSO.GetParentFolderName(oFSO.GetFile(Wscript.ScriptFullName)) & "\" & sInstFile + Set f = oFSO.OpenTextFile(sInstFile) + s = f.ReadAll + f.Close + Set f = Nothing + Set oFSO = Nothing + ExecuteGlobal s +End Sub \ No newline at end of file From 9b2cb5a9b0d08c85987f614d6f36fe05d4d80cad Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sat, 27 Aug 2022 22:05:13 +0800 Subject: [PATCH 008/129] vbs: rewrite code1 --- impls/vbs/printer.vbs | 2 +- impls/vbs/reader.vbs | 190 +++++++++++++++++++-------------- impls/vbs/step0_repl.vbs | 30 +++--- impls/vbs/step1_read_print.vbs | 50 ++++----- impls/vbs/step2_eval.vbs | 7 +- 5 files changed, 160 insertions(+), 119 deletions(-) diff --git a/impls/vbs/printer.vbs b/impls/vbs/printer.vbs index d0a818dfa6..9851496e7b 100644 --- a/impls/vbs/printer.vbs +++ b/impls/vbs/printer.vbs @@ -1,5 +1,5 @@ Function pr_str(o,print_readably) - msgbox typename(o) = "Nothing" + 'msgbox typename(o) = "Nothing" if typename(o) = "Nothing" then pr_str = "" exit function diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs index 71173a6d5f..bb779ae572 100644 --- a/impls/vbs/reader.vbs +++ b/impls/vbs/reader.vbs @@ -1,35 +1,33 @@ Include "printer.vbs" Class MalType - Public Type_ - Public value_ + Public Type + Public Value End Class - -'msgbox pr_str(read_str("(123 (456, 567))")) -'msgbox typename(CreateObject("System.Collections.ArrayList")) -'msgbox pr_str(read_str("(123 ")) -Function read_str(str) - set read_str=read_form(tokenize(str)) - 'msgbox pr_str(read_str,true) +Function ReadString(strCode) + Set ReadString = ReadForm(Tokenize(strCode)) End Function -Function tokenize(str) - Set oQueue = CreateObject("System.Collections.Queue") - Set regEx = New RegExp - regEx.Pattern = "[\s,]*(~@|[\[\]{}()'`~^@]|""(?:\\.|[^\\""])*""?|;.*|[^\s\[\]{}('""`,;)]*)" - regEx.IgnoreCase = True - regEx.Global = True - Set Matches = regEx.Execute(str) - For Each Match In Matches - 'msgbox Match.SubMatches(0) - if not left(Match.SubMatches(0), 1) = ";" then - oQueue.Enqueue(Match.SubMatches(0)) - End if +Function Tokenize(strCode) + Set objRE = New RegExp + With objRE + .Pattern = "[\s,]*(~@|[\[\]{}()'`~^@]|""(?:\\.|[^\\""])*""?|;.*|[^\s\[\]{}('""`,;)]*)" + .IgnoreCase = True + .Global = True + End With + + Set objTokens = CreateObject("System.Collections.Queue") + Set objMatches = objRE.Execute(strCode) + Dim strToken + For Each objMatch In objMatches + strToken = Match.SubMatches(0) + If Not Left(strToken, 1) = ";" Then + objTokens.Enqueue strToken + End If Next - Set regEx = Nothing - Set Matches = Nothing - Set tokenize = oQueue + + Set Tokenize = objTokens End Function Function read_form_(oQueue) @@ -40,21 +38,26 @@ Function read_form_(oQueue) end if End Function -Function read_form(oQueue) - if oQueue.Count = 0 then - Set read_form = Nothing - exit function - end if - If oQueue.Peek() = "(" or oQueue.Peek() = "[" or oQueue.Peek() = "{" Then - if oQueue.Peek() = "(" then - Set read_form = read_list(oQueue) - elseif oQueue.Peek() = "[" then - Set read_form = read_vector(oQueue) - elseif oQueue.Peek() = "{" then - Set read_form = read_hash_map(oQueue) - end if - elseif oQueue.Peek() = "'" or oQueue.Peek() = "`" or oQueue.Peek() = "~" or oQueue.Peek() = "~@" or oQueue.Peek = "@" then - select case oQueue.Dequeue() +Function ReadForm(objTokens) + If objTokens.Count = 0 Then + Set ReadForm = Nothing + Exit Function + End If + + Dim strToken + strToken = objTokens.Peek() + + If InStr("([{", strToken) Then + Select Case strToken + Case "(" + Set ReadForm = ReadList(oQueue) + Case "[" + Set ReadForm = ReadVector(oQueue) + Case "{" + Set ReadForm = ReadHashmap(oQueue) + End Select + ElseIf InStr("'`~@", strToken) Then + Select Case strToken case "'" s = "quote" case "`" @@ -97,52 +100,83 @@ Function read_form(oQueue) End Function -Function read_list(oQueue) - p = oQueue.Dequeue() - if p = "(" Then - q = ")" - elseif p = "[" then - q = "]" - elseif p = "{" then - q = "}" - end if - - set read_list = new MalType - set read_list.value_ = CreateObject("System.Collections.ArrayList") - read_list.type_ = "list"+p+q - - While oQueue.count > 1 And oQueue.Peek() <> q - read_list.value_.Add read_form(oQueue) - Wend - If oQueue.Dequeue() <> q Then - err.raise vbObjectError,"reader", "excepted '"+q+"', got EOF" +Function ReadList(objTokens) + Call objTokens.Dequeue() + + If objTokens.Count = 0 Then + 'TODO + End If + + Set ReadList = New MalType + Set ReadList.Value = CreateObject("System.Collections.ArrayList") + ReadList.Type = "List" + + With ReadList.Value + While objTokens.Count > 1 And objTokens.Peek() <> ")" + .Add ReadForm(objTokens) + Wend + End With + + If objTokens.Dequeue() <> ")" Then + 'TODO + 'Err.raise vbObjectError,"reader", "excepted '"+q+"', got EOF" End If - 'msgbox oQueue.peek End Function -function read_vector(oQueue) - set read_vector = read_list(oQueue) -end function - -function read_hash_map(oQueue) - oQueue.Dequeue() - set read_hash_map = new MalType - set read_hash_map.value_ = CreateObject("Scripting.Dictionary") - - read_hash_map.type_ = "hash-map" - While oQueue.count > 1 And oQueue.Peek() <> "}" - set key = read_form(oQueue) - read_hash_map.value_.Add key, read_form(oQueue) - Wend - If oQueue.Dequeue() <> "}" Then - err.raise vbObjectError,"reader", "excepted '}', got EOF" +function ReadVector(objTokens) + Call objTokens.Dequeue() + + If objTokens.Count = 0 Then + 'TODO + End If + + Set ReadVector = New MalType + Set ReadVector.Value = CreateObject("System.Collections.ArrayList") + ReadVector.Type = "Vector" + + With ReadVector.Value + While objTokens.Count > 1 And objTokens.Peek() <> "]" + .Add ReadForm(objTokens) + Wend + End With + + If objTokens.Dequeue() <> "]" Then + 'TODO + 'err.raise vbObjectError,"reader", "excepted '"+q+"', got EOF" End If End Function +Function ReadHashmap(objTokens) + Call objTokens.Dequeue() + + If objTokens.Count < 2 Then + 'TODO + End If + + Set ReadHashmap = New MalType + Set ReadHashmap.Value = CreateObject("Scripting.Dictionary") + ReadHashmap.Type = "Hashmap" + + Dim objKey, objValue + With ReadHashmap.Value + While objTokens.Count > 2 And objTokens.Peek() <> "}" + Set objKey = ReadForm(oQueue) + Set objValue = ReadForm(oQueue) + .Add objKey, objValue + Wend + End With + + If objTokens.Dequeue() <> "}" Then + 'TODO + 'err.raise vbObjectError,"reader", "excepted '}', got EOF" + End If +End Function - -Function read_atom(oQueue) - atom = oQueue.Dequeue() +Function ReadAtom(objTokens) + Dim strAtom + strAtom = objTokens.Dequeue() + + 'TODO if atom = "" then set read_atom = Nothing elseif isnumeric(atom) Then diff --git a/impls/vbs/step0_repl.vbs b/impls/vbs/step0_repl.vbs index 4143b3e3e0..bc9d6e3283 100644 --- a/impls/vbs/step0_repl.vbs +++ b/impls/vbs/step0_repl.vbs @@ -1,21 +1,27 @@ -Function READ(str) - READ = str +Option Explicit + +Function Read(strCode) + Read = strCode End Function -Function EVAL(str) - EVAL = str +Function Evaluate(strCode) + Evaluate = strCode End Function -Function PRINT(str) - PRINT = str +Function Print(strCode) + Print = strCode End Function -Function rep(str) - rep = PRINT(EVAL(READ(str))) +Function REP(strCode) + REP = Print(Evaluate(Read(strCode))) End Function -While True - WScript.StdOut.Write("user> ") - code = WScript.StdIn.ReadLine() - WScript.Echo(rep(code)) +Dim strCode +While True 'REPL + 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 diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index 00fb020e33..4f8fda922c 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -1,39 +1,39 @@ Include "reader.vbs" Include "printer.vbs" -Function READ(str) - set READ = read_str(str) +Option Explicit + +Function Read(strCode) + Read = strCode End Function -Function EVAL(oMal) - set EVAL = oMal +Function Evaluate(strCode) + Evaluate = strCode End Function -Function PRINT(oMal) - PRINT = pr_str(oMal,true) +Function Print(strCode) + Print = strCode End Function -Function rep(str) - on error resume next - rep = PRINT(EVAL(READ(str))) - if err.number <> 0 then rep = err.description - on error goto 0 +Function REP(strCode) + REP = Print(Evaluate(Read(strCode))) End Function -While True - WScript.StdOut.Write("user> ") - code = WScript.StdIn.ReadLine() - WScript.Echo(rep(code)) +Dim strCode +While True 'REPL + 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 -Sub Include(sInstFile) - Dim oFSO, f, s - Set oFSO = CreateObject("Scripting.FileSystemObject") - sInstFile = oFSO.GetParentFolderName(oFSO.GetFile(Wscript.ScriptFullName)) & "\" & sInstFile - Set f = oFSO.OpenTextFile(sInstFile) - s = f.ReadAll - f.Close - Set f = Nothing - Set oFSO = Nothing - ExecuteGlobal s +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With End Sub \ No newline at end of file diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs index a50ad4c4dc..7977aad6e9 100644 --- a/impls/vbs/step2_eval.vbs +++ b/impls/vbs/step2_eval.vbs @@ -29,7 +29,7 @@ end function function donothing(args) set donothing = new MalType donothing.type_ = "nil" - donothing.value_ = "error" + donothing.value_ = "" end function class enviroment @@ -50,8 +50,9 @@ Function READ(str) End Function Function EVAL(oMal,env) - 'msgbox typename(o) - if isempty(o) then + 'msgbox typename(oMal) + if TypeName(oMal) = "Nothing" then + 'msgbox "nothing" set EVAL = donothing("") exit function end if From 4bc295e286c10f5e4bc56836a1a4a610a9ea6263 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sun, 28 Aug 2022 00:00:10 +0800 Subject: [PATCH 009/129] vbs: rewrite code 2 --- impls/vbs/const.vbs | 14 +++ impls/vbs/env.vbs | 32 ++++++ impls/vbs/printer.vbs | 122 ++++++++++++-------- impls/vbs/reader.vbs | 247 ++++++++++++++++++++-------------------- impls/vbs/step3_env.vbs | 130 +++++++++++++++++++++ 5 files changed, 375 insertions(+), 170 deletions(-) create mode 100644 impls/vbs/const.vbs create mode 100644 impls/vbs/env.vbs create mode 100644 impls/vbs/step3_env.vbs diff --git a/impls/vbs/const.vbs b/impls/vbs/const.vbs new file mode 100644 index 0000000000..4790c4d2f5 --- /dev/null +++ b/impls/vbs/const.vbs @@ -0,0 +1,14 @@ +Const TYPE_LIST = 0 +Const TYPE_VECTOR = 1 +Const TYPE_HASHMAP = 2 +Const TYPE_BOOLEAN = 3 +Const TYPE_NIL = 4 +Const TYPE_KEYWORD = 5 +Const TYPE_STRING = 6 +Const TYPE_NUMBER = 7 +Const TYPE_SYMBOL = 8 + +Class MalType + Public [Type] + Public Value +End Class diff --git a/impls/vbs/env.vbs b/impls/vbs/env.vbs new file mode 100644 index 0000000000..7586079e9d --- /dev/null +++ b/impls/vbs/env.vbs @@ -0,0 +1,32 @@ + +class enviroment + public data + private sub Class_Initialize() + set data = CreateObject("Scripting.Dictionary") + + end sub + + public sub setOuter(outer) + data.add "outer", outer + end sub + + public sub set_(symbolKey,malValue) + data.add symbolKey, malValue + end sub + + public function find(symbolKey) + if data.Exists(symbolKey) then + set find = data + else + if data.item("outer") = empty then + err.raise vbObjectError, "find", "not found, undefined symbol: " & symbolKey + else + set find = data.item("outer").find(symbolKey) + end if + end if + end function + + public function get_(symbolKey) + set get_ = find(symbolKey).item(symbolKey) + end function +end class \ No newline at end of file diff --git a/impls/vbs/printer.vbs b/impls/vbs/printer.vbs index 9851496e7b..57247a6b13 100644 --- a/impls/vbs/printer.vbs +++ b/impls/vbs/printer.vbs @@ -1,53 +1,79 @@ -Function pr_str(o,print_readably) - 'msgbox typename(o) = "Nothing" - if typename(o) = "Nothing" then - pr_str = "" - exit function - end if - If left(o.type_,4) = "list" Then - pr_str =mid(o.type_,5,1) - bool = False - For Each item In o.value_ - bool = True - pr_str =pr_str & pr_str(item,print_readably) & " " - Next - if bool then - pr_str = left(pr_str,len(pr_str)-1) & mid(o.type_,6,1) - else - pr_str = mid(o.type_,5,2) - End If - elseif o.type_ = "hash-map" Then - pr_str = "{" - bool = False - For each item in o.value_ - bool = True - pr_str =pr_str & pr_str(item,print_readably) & " " & pr_str(o.value_.item(item),print_readably) & " " - Next - if bool then - pr_str = left(pr_str,len(pr_str)-1) & "}" - else - pr_str = "{}" - End If - Else - if print_readably and o.type_="string" then - pr_str = o.value_ - pr_str = replace(pr_str,"\","\\") - pr_str = replace(pr_str,vbnewline,"\n") - pr_str = replace(pr_str,"""","\""") - pr_str = """" & pr_str & """" - Elseif o.type_="string" then - pr_str = """" & o.value_ & """" - else - pr_str = o.value_ - End If +Function PrintMalType(objMal, boolReadable) + PrintMalType = "" + If TypeName(objMal) = "Nothing" Then + Exit Function End If + Select Case objMal.Type + Case TYPE_LIST + With objMal.Value + Dim i + For i = 0 To .Count - 2 + PrintMalType = PrintMalType & _ + PrintMalType(.Item(i), boolReadable) & " " + Next + If .Count > 0 Then + PrintMalType = PrintMalType & _ + PrintMalType(.Item(.Count - 1), boolReadable) + End If + End With + PrintMalType = "(" & PrintMalType & ")" + Case TYPE_VECTOR + With objMal.Value + Dim i + For i = 0 To .Count - 2 + PrintMalType = PrintMalType & _ + PrintMalType(.Item(i), boolReadable) & " " + Next + If .Count > 0 Then + PrintMalType = PrintMalType & _ + PrintMalType(.Item(.Count - 1), boolReadable) + End If + End With + PrintMalType = "[" & PrintMalType & "]" + Case TYPE_HASHMAP + With objMal.Value + Dim arrKeys + arrKeys = .Keys + Dim i + For i = 0 To .Count - 2 + PrintMalType = PrintMalType & _ + PrintMalType(arrKeys(i), boolReadable) & " " & _ + PrintMalType(.Item(arrKeys(i)), boolReadable) & " " + Next + If .Count > 0 Then + PrintMalType = PrintMalType & _ + PrintMalType(arrKeys(.Count - 1), boolReadable) & " " & _ + PrintMalType(.Item(arrKeys(.Count - 1)), boolReadable) + End If + End With + PrintMalType = "{" & PrintMalType & "}" + Case TYPE_STRING + If boolReadable Then + PrintMalType = EscapeString(objMal.Value) + Else + PrintMalType = objMal.Value + End If + Case TYPE_BOOLEAN + If objMal.Value Then + PrintMalType = "true" + Else + PrintMalType = "false" + End If + Case TYPE_NIL + PrintMalType = "nil" + Case TYPE_NUMBER + PrintMalType = CStr(objMal.Value) + Case Else + PrintMalType = objMal.Value + End Select End Function -' set list = CreateObject("System.Collections.ArrayList") -' list.add(3) -' for each i in list -' msgbox i -' next - +Function EscapeString(strRaw) + EscapeString = strRaw + EscapeString = Replace(EscapeString, "\", "\\") + EscapeString = Replace(EscapeString, vbCrLf, "\n") + EscapeString = Replace(EscapeString, """", "\""") + EscapeString = """" & EscapeString & """" +End Function \ No newline at end of file diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs index bb779ae572..aad2008263 100644 --- a/impls/vbs/reader.vbs +++ b/impls/vbs/reader.vbs @@ -1,10 +1,3 @@ -Include "printer.vbs" - -Class MalType - Public Type - Public Value -End Class - Function ReadString(strCode) Set ReadString = ReadForm(Tokenize(strCode)) End Function @@ -30,13 +23,13 @@ Function Tokenize(strCode) Set Tokenize = objTokens End Function -Function read_form_(oQueue) - set read_form_=read_form(oQueue) - 'msgbox pr_str(read_form_),true - if oQueue.Count > 0 then - err.raise vbObjectError,"SyntaxError", "Extra data after form: " + oQueue.Dequeue - end if -End Function +'Function read_form_(oQueue) +' set read_form_=read_form(oQueue) +' 'msgbox pr_str(read_form_),true +' if oQueue.Count > 0 then +' err.raise vbObjectError,"SyntaxError", "Extra data after form: " + oQueue.Dequeue +' end if +'End Function Function ReadForm(objTokens) If objTokens.Count = 0 Then @@ -50,54 +43,55 @@ Function ReadForm(objTokens) If InStr("([{", strToken) Then Select Case strToken Case "(" - Set ReadForm = ReadList(oQueue) + Set ReadForm = ReadList(objTokens) Case "[" - Set ReadForm = ReadVector(oQueue) + Set ReadForm = ReadVector(objTokens) Case "{" - Set ReadForm = ReadHashmap(oQueue) + Set ReadForm = ReadHashmap(objTokens) End Select ElseIf InStr("'`~@", strToken) Then + Dim strAlias Select Case strToken - case "'" - s = "quote" - case "`" - s = "quasiquote" - case "~" - s = "unquote" - case "~@" - s = "splice-unquote" - case "@" - s = "deref" - end select - set o = new MalType - o.Type_ = "symbol" - o.value_ = s - set l = new MalType - l.Type_ = "list()" - set l.value_ = CreateObject("System.Collections.ArrayList") - l.value_.Add(o) - l.value_.Add(read_form(oQueue)) - set read_form = l - elseif oQueue.Peek() = ")" or oQueue.Peek() = "]" or oQueue.Peek() = "}" then - Set read_form = Nothing - err.Raise vbObjectError, "read_form", "unbalanced parentheses" - elseif oQueue.Peek() = "^" then + Case "'" + strAlias = "quote" + Case "`" + strAlias = "quasiquote" + Case "~" + strAlias = "unquote" + Case "~@" + strAlias = "splice-unquote" + Case "@" + strAlias = "deref" + Case Else + 'TODO + End Select + + Set ReadForm = New MalType + ReadForm.Type = TYPE_LIST + Set ReadForm.Value = CreateObject("System.Collections.ArrayList") + ReadForm.Value.Add New MalType + ReadForm.Value.Item(0).Type = TYPE_SYMBOL + ReadForm.Value.Item(0).Value = strAlias + ReadForm.Value.Add ReadForm(objTokens) + 'TODO + 'ElseIf oQueue.Peek() = ")" or oQueue.Peek() = "]" or oQueue.Peek() = "}" then + ' Set read_form = Nothing + ' err.Raise vbObjectError, "read_form", "unbalanced parentheses" + ElseIf strToken = "^" Then oQueue.Dequeue() - set o = new MalType - o.Type_ = "symbol" - o.value_ = "with-meta" - set l = new MalType - l.Type_ = "list()" - set l.value_ = CreateObject("System.Collections.ArrayList") - l.value_.Add(o) - set tmp = read_form(oQueue) - l.value_.Add(read_form(oQueue)) - l.value_.Add(tmp) - set read_form = l + Set ReadForm = New MalType + ReadForm.Type = TYPE_LIST + Set ReadForm.Value = CreateObject("System.Collections.ArrayList") + ReadForm.Value.Add New MalType + ReadForm.Value.Item(0).Type = TYPE_SYMBOL + ReadForm.Value.Item(0).Value = "with-meta" + Dim objTemp + Set objTemp = ReadForm(objTokens) + ReadForm.Value.Add ReadForm(objTokens) + ReadForm.Value.Add objTemp Else - set read_form = read_atom(oQueue) + Set read_form = read_atom(oQueue) End If - End Function Function ReadList(objTokens) @@ -109,7 +103,7 @@ Function ReadList(objTokens) Set ReadList = New MalType Set ReadList.Value = CreateObject("System.Collections.ArrayList") - ReadList.Type = "List" + ReadList.Type = TYPE_LIST With ReadList.Value While objTokens.Count > 1 And objTokens.Peek() <> ")" @@ -132,7 +126,7 @@ function ReadVector(objTokens) Set ReadVector = New MalType Set ReadVector.Value = CreateObject("System.Collections.ArrayList") - ReadVector.Type = "Vector" + ReadVector.Type = TYPE_VECTOR With ReadVector.Value While objTokens.Count > 1 And objTokens.Peek() <> "]" @@ -155,7 +149,7 @@ Function ReadHashmap(objTokens) Set ReadHashmap = New MalType Set ReadHashmap.Value = CreateObject("Scripting.Dictionary") - ReadHashmap.Type = "Hashmap" + ReadHashmap.Type = TYPE_HASHMAP Dim objKey, objValue With ReadHashmap.Value @@ -176,70 +170,79 @@ Function ReadAtom(objTokens) Dim strAtom strAtom = objTokens.Dequeue() - 'TODO - if atom = "" then - set read_atom = Nothing - elseif isnumeric(atom) Then - set read_atom = new MalType - read_atom.Type_ = "number" - read_atom.value_ = cdbl(atom) - 'msgbox "here" - elseif atom = "true" or atom = "false" Then - set read_atom = new MalType - read_atom.Type_ = "boolean" - read_atom.value_ = atom - elseif left(atom,1) = """" Then - if (not right(atom,1) = """") or len(atom) = 1 then err.raise vbObjectError,"reader", "Unterminated string, got EOF" - set read_atom = new MalType - read_atom.Type_ = "string" - str_tmp = "" - for i = 2 to len(atom) - 1 - if backslash then - backslash = False - 'msgbox backslash - if mid(atom,i,1) = "n" then - str_tmp = str_tmp + vbnewline - elseif mid(atom,i,1) = "\" then - str_tmp = str_tmp + "\" - elseif mid(atom,i,1) = """" then - str_tmp = str_tmp + """" - end if - else - if mid(atom,i,1) = "\" then - backslash = True - else - str_tmp = str_tmp + mid(atom,i,1) - end if - end if - next - if backslash then err.raise vbObjectError,"reader", "Unterminated string, got EOF" - read_atom.value_ = str_tmp - elseif atom = "nil" Then - set read_atom = new MalType - read_atom.Type_ = "null" - read_atom.value_ = atom - elseif left(atom,1) = ":" Then - set read_atom = new MalType - read_atom.Type_ = "keyword" - read_atom.value_ = atom - elseif left(atom,1) = ";" Then - set read_atom = nothing - else - set read_atom = new MalType - read_atom.Type_ = "symbol" - read_atom.value_ = atom - End If + Dim objAtom + Set objAtom = New MalType + Select Case strAtom + Case "true" + objAtom.Type = TYPE_BOOLEAN + objAtom.Value = True + Case "false" + objAtom.Type = TYPE_BOOLEAN + objAtom.Value = False + Case "nil" + objAtom.Type = TYPE_NIL + objAtom.Value = Null + Case Else + Select Case Left(strAtom, 1) + Case ":" + objAtom.Type = TYPE_KEYWORD + objAtom.Value = strAtom + Case """" + 'TODO check string + 'if (not right(atom,1) = """") or len(atom) = 1 then err.raise vbObjectError,"reader", "Unterminated string, got EOF" + objAtom.Type = TYPE_STRING + objAtom.Value = ParseString(strAtom) + Case Else + If IsNumeric(strAtom) + objAtom.Type = TYPE_NUMBER + objAtom.Value = Eval(strAtom) + Else + objAtom.Type = TYPE_SYMBOL + objAtom.Value = strAtom + End If + End Select + End Select + + Set ReadAtom = objAtom End Function - -Sub Include(sInstFile) - Dim oFSO, f, s - Set oFSO = CreateObject("Scripting.FileSystemObject") - sInstFile = oFSO.GetParentFolderName(oFSO.GetFile(Wscript.ScriptFullName)) & "\" & sInstFile - Set f = oFSO.OpenTextFile(sInstFile) - s = f.ReadAll - f.Close - Set f = Nothing - Set oFSO = Nothing - ExecuteGlobal s -End Sub \ No newline at end of file +Function ParseString(strRaw) + ParseString = strRaw + 'TODO +' Dim atom +' atom=strAtom +' if atom = "" then +' set read_atom = Nothing +' elseif left(atom,1) = """" Then +' set read_atom = new MalType +' read_atom.Type_ = "string" +' str_tmp = "" +' for i = 2 to len(atom) - 1 +' if backslash then +' backslash = False +' 'msgbox backslash +' if mid(atom,i,1) = "n" then +' str_tmp = str_tmp + vbnewline +' elseif mid(atom,i,1) = "\" then +' str_tmp = str_tmp + "\" +' elseif mid(atom,i,1) = """" then +'' str_tmp = str_tmp + """" +' end if +' else +' if mid(atom,i,1) = "\" then +' backslash = True +' else +' str_tmp = str_tmp + mid(atom,i,1) +' end if +' end if +' next +' if backslash then err.raise vbObjectError,"reader", "Unterminated string, got EOF" +' read_atom.value_ = str_tmp + 'elseif left(atom,1) = ";" Then + ' set read_atom = nothing + 'else + ' set read_atom = new MalType + ' read_atom.Type_ = "symbol" + ' read_atom.value_ = atom + 'End If +End Function diff --git a/impls/vbs/step3_env.vbs b/impls/vbs/step3_env.vbs new file mode 100644 index 0000000000..8eb674c344 --- /dev/null +++ b/impls/vbs/step3_env.vbs @@ -0,0 +1,130 @@ +Include "reader.vbs" +Include "printer.vbs" +Include "env.vbs" + +function add(args) + set add = new MalType + add.type_ = "number" + 'msgbox typename(args) + add.value_ = args.value_.item(1).value_ + args.value_.item(2).value_ +end function + +function subtract(args) + set subtract = new MalType + subtract.type_ = "number" + subtract.value_ = args.value_.item(1).value_ - args.value_.item(2).value_ +end function + +function multiply(args) + set multiply = new MalType + multiply.type_ = "number" + multiply.value_ = args.value_.item(1).value_ * args.value_.item(2).value_ +end function + +function divide(args) + set divide = new MalType + divide.type_ = "number" + divide.value_ = args.value_.item(1).value_ / args.value_.item(2).value_ +end function + +function donothing(args) + set donothing = new MalType + donothing.type_ = "nil" + donothing.value_ = "" +end function + + +Function READ(str) + set READ = read_str(str) +End Function + +Function EVAL(oMal,env) + 'msgbox typename(oMal) + if TypeName(oMal) = "Nothing" then + 'msgbox "nothing" + set EVAL = donothing("") + exit function + end if + select case oMal.type_ + case "list()" + if oMal.value_.count = 0 then + set EVAL = oMal + else + 'wsh.echo oMal.value_.item(0).value_ + 'wsh.echo typename(env.env) + 'msgbox eval_ast(oMal.value_.item(1),env).value_ + 'msgbox typename(env.env.item("+")(oMal)) + 'if not isempty(oMal.value_.item(0)) then + set EVAL = env.env.item(eval_ast(oMal.value_.item(0),env).value_)(eval_ast(oMal,env)) + 'else + 'end if + end if + case else + set EVAL = eval_ast(oMal,env) + end select +End Function + +function eval_ast(ast,env) + select case ast.type_ + case "list()" + for i = 0 to ast.value_.count - 1 + set ast.value_.item(i) = EVAL(ast.value_.item(i),env) + next + set eval_ast = ast + case "symbol" + if env.env.Exists(ast.value_) then + set eval_ast = ast + else + 'err.raise vbObjectError, "eval_ast", "undefined symbol: " & ast.value_ + wsh.echo "undefined symbol: " & ast.value_ + ast.value_ = "donothing" + set eval_ast = ast + end if + case "list[]" + for i = 0 to ast.value_.count - 1 + set ast.value_.item(i) = EVAL(ast.value_.item(i),env) + next + set eval_ast = ast + case "hash-map" + For i = 0 To ast.value_.Count -1 ' 迭代数组。 + ' wsh.echo ast.value_.keys()(i).value_ + ' wsh.echo ast.value_.item(ast.value_.keys()(i)).value_ + set ast.value_.item(ast.value_.keys()(i)) = EVAL(ast.value_.item(ast.value_.keys()(i)),env) + Next + set eval_ast = ast + case else + set eval_ast = ast + end select +end function + + +Function PRINT(oMal) + PRINT = pr_str(oMal,true) +End Function + +Function rep(str,env) + 'on error resume next + rep = PRINT(EVAL(READ(str),env)) + 'msgbox 2 + if err.number <> 0 then rep = err.description + on error goto 0 +End Function + +While True + WScript.StdOut.Write("user> ") + code = WScript.StdIn.ReadLine() + set env = new enviroment + WScript.Echo(rep(code,env)) +WEnd + +Sub Include(sInstFile) + Dim oFSO, f, s + Set oFSO = CreateObject("Scripting.FileSystemObject") + sInstFile = oFSO.GetParentFolderName(oFSO.GetFile(Wscript.ScriptFullName)) & "\" & sInstFile + Set f = oFSO.OpenTextFile(sInstFile) + s = f.ReadAll + f.Close + Set f = Nothing + Set oFSO = Nothing + ExecuteGlobal s +End Sub \ No newline at end of file From c8371b171e4e3ea5cc0bb2a33e4b4ccebf280a78 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sun, 28 Aug 2022 00:53:12 +0800 Subject: [PATCH 010/129] vbs: rewrite 3 --- impls/vbs/printer.vbs | 7 +-- impls/vbs/reader.vbs | 101 ++++++++++++++++++--------------- impls/vbs/step1_read_print.vbs | 37 ++++++------ 3 files changed, 78 insertions(+), 67 deletions(-) diff --git a/impls/vbs/printer.vbs b/impls/vbs/printer.vbs index 57247a6b13..acb7947aca 100644 --- a/impls/vbs/printer.vbs +++ b/impls/vbs/printer.vbs @@ -1,13 +1,15 @@ +Option Explicit + Function PrintMalType(objMal, boolReadable) PrintMalType = "" If TypeName(objMal) = "Nothing" Then Exit Function End If + Dim i Select Case objMal.Type Case TYPE_LIST With objMal.Value - Dim i For i = 0 To .Count - 2 PrintMalType = PrintMalType & _ PrintMalType(.Item(i), boolReadable) & " " @@ -20,7 +22,6 @@ Function PrintMalType(objMal, boolReadable) PrintMalType = "(" & PrintMalType & ")" Case TYPE_VECTOR With objMal.Value - Dim i For i = 0 To .Count - 2 PrintMalType = PrintMalType & _ PrintMalType(.Item(i), boolReadable) & " " @@ -35,7 +36,6 @@ Function PrintMalType(objMal, boolReadable) With objMal.Value Dim arrKeys arrKeys = .Keys - Dim i For i = 0 To .Count - 2 PrintMalType = PrintMalType & _ PrintMalType(arrKeys(i), boolReadable) & " " & _ @@ -69,7 +69,6 @@ Function PrintMalType(objMal, boolReadable) End Select End Function - Function EscapeString(strRaw) EscapeString = strRaw EscapeString = Replace(EscapeString, "\", "\\") diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs index aad2008263..a6dd9ef8c4 100644 --- a/impls/vbs/reader.vbs +++ b/impls/vbs/reader.vbs @@ -1,8 +1,11 @@ +Option Explicit + Function ReadString(strCode) Set ReadString = ReadForm(Tokenize(strCode)) End Function Function Tokenize(strCode) + Dim objRE Set objRE = New RegExp With objRE .Pattern = "[\s,]*(~@|[\[\]{}()'`~^@]|""(?:\\.|[^\\""])*""?|;.*|[^\s\[\]{}('""`,;)]*)" @@ -10,16 +13,18 @@ Function Tokenize(strCode) .Global = True End With + Dim objTokens, objMatches, objMatch Set objTokens = CreateObject("System.Collections.Queue") Set objMatches = objRE.Execute(strCode) Dim strToken For Each objMatch In objMatches - strToken = Match.SubMatches(0) + strToken = objMatch.SubMatches(0) If Not Left(strToken, 1) = ";" Then objTokens.Enqueue strToken End If Next - + 'MsgBox objTokens.Count + 'MsgBox """" & objTokens.peek & """" Set Tokenize = objTokens End Function @@ -37,6 +42,12 @@ Function ReadForm(objTokens) Exit Function End If + If objTokens.Count = 1 And objTokens.Peek() = "" Then + Call objTokens.Dequeue() + Set ReadForm = Nothing + Exit Function + End If + Dim strToken strToken = objTokens.Peek() @@ -50,6 +61,8 @@ Function ReadForm(objTokens) Set ReadForm = ReadHashmap(objTokens) End Select ElseIf InStr("'`~@", strToken) Then + Call objTokens.Dequeue() + Dim strAlias Select Case strToken Case "'" @@ -78,7 +91,7 @@ Function ReadForm(objTokens) ' Set read_form = Nothing ' err.Raise vbObjectError, "read_form", "unbalanced parentheses" ElseIf strToken = "^" Then - oQueue.Dequeue() + Call objTokens.Dequeue() Set ReadForm = New MalType ReadForm.Type = TYPE_LIST Set ReadForm.Value = CreateObject("System.Collections.ArrayList") @@ -90,7 +103,7 @@ Function ReadForm(objTokens) ReadForm.Value.Add ReadForm(objTokens) ReadForm.Value.Add objTemp Else - Set read_form = read_atom(oQueue) + Set ReadForm = ReadAtom(objTokens) End If End Function @@ -113,6 +126,7 @@ Function ReadList(objTokens) If objTokens.Dequeue() <> ")" Then 'TODO + MsgBox "e" 'Err.raise vbObjectError,"reader", "excepted '"+q+"', got EOF" End If End Function @@ -136,6 +150,7 @@ function ReadVector(objTokens) If objTokens.Dequeue() <> "]" Then 'TODO + MsgBox "e" 'err.raise vbObjectError,"reader", "excepted '"+q+"', got EOF" End If End Function @@ -154,8 +169,8 @@ Function ReadHashmap(objTokens) Dim objKey, objValue With ReadHashmap.Value While objTokens.Count > 2 And objTokens.Peek() <> "}" - Set objKey = ReadForm(oQueue) - Set objValue = ReadForm(oQueue) + Set objKey = ReadForm(objTokens) + Set objValue = ReadForm(objTokens) .Add objKey, objValue Wend End With @@ -193,7 +208,7 @@ Function ReadAtom(objTokens) objAtom.Type = TYPE_STRING objAtom.Value = ParseString(strAtom) Case Else - If IsNumeric(strAtom) + If IsNumeric(strAtom) Then objAtom.Type = TYPE_NUMBER objAtom.Value = Eval(strAtom) Else @@ -207,42 +222,38 @@ Function ReadAtom(objTokens) End Function Function ParseString(strRaw) - ParseString = strRaw - 'TODO -' Dim atom -' atom=strAtom -' if atom = "" then -' set read_atom = Nothing -' elseif left(atom,1) = """" Then -' set read_atom = new MalType -' read_atom.Type_ = "string" -' str_tmp = "" -' for i = 2 to len(atom) - 1 -' if backslash then -' backslash = False -' 'msgbox backslash -' if mid(atom,i,1) = "n" then -' str_tmp = str_tmp + vbnewline -' elseif mid(atom,i,1) = "\" then -' str_tmp = str_tmp + "\" -' elseif mid(atom,i,1) = """" then -'' str_tmp = str_tmp + """" -' end if -' else -' if mid(atom,i,1) = "\" then -' backslash = True -' else -' str_tmp = str_tmp + mid(atom,i,1) -' end if -' end if -' next -' if backslash then err.raise vbObjectError,"reader", "Unterminated string, got EOF" -' read_atom.value_ = str_tmp - 'elseif left(atom,1) = ";" Then - ' set read_atom = nothing - 'else - ' set read_atom = new MalType - ' read_atom.Type_ = "symbol" - ' read_atom.value_ = atom - 'End If + If Right(strRaw, 1) <> """" Or Len(strRaw) < 2 Then + MsgBox "e" + End If + + Dim strTemp + strTemp = Mid(strRaw, 2, Len(strRaw) - 2) + Dim i + i = 1 + 'Dim strChar + 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 + 'TODO Error + MsgBox "err" + End If + End If End Function diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index 4f8fda922c..4fc2b3aa6f 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -1,34 +1,35 @@ -Include "reader.vbs" -Include "printer.vbs" - Option Explicit +Include "Const.vbs" +Include "Reader.vbs" +Include "Printer.vbs" + +Dim strCode +While True 'REPL + 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 + Function Read(strCode) - Read = strCode + Set Read = ReadString(strCode) End Function -Function Evaluate(strCode) - Evaluate = strCode +Function Evaluate(objCode) + Set Evaluate = objCode End Function -Function Print(strCode) - Print = strCode +Function Print(objCode) + Print = PrintMalType(objCode, True) End Function Function REP(strCode) REP = Print(Evaluate(Read(strCode))) End Function -Dim strCode -While True 'REPL - 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 - Sub Include(strFileName) With CreateObject("Scripting.FileSystemObject") ExecuteGlobal .OpenTextFile( _ From 129262b4623a4a1c79b0d49ecba648e60c0546f0 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sun, 28 Aug 2022 10:18:52 +0800 Subject: [PATCH 011/129] vbs: fix error dealing --- impls/vbs/reader.vbs | 68 ++++++++++++++++++---------------- impls/vbs/step1_read_print.vbs | 26 ++++++++----- 2 files changed, 53 insertions(+), 41 deletions(-) diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs index a6dd9ef8c4..5437a44801 100644 --- a/impls/vbs/reader.vbs +++ b/impls/vbs/reader.vbs @@ -23,18 +23,11 @@ Function Tokenize(strCode) objTokens.Enqueue strToken End If Next - 'MsgBox objTokens.Count - 'MsgBox """" & objTokens.peek & """" + Set Tokenize = objTokens End Function -'Function read_form_(oQueue) -' set read_form_=read_form(oQueue) -' 'msgbox pr_str(read_form_),true -' if oQueue.Count > 0 then -' err.raise vbObjectError,"SyntaxError", "Extra data after form: " + oQueue.Dequeue -' end if -'End Function +Public boolError, strError Function ReadForm(objTokens) If objTokens.Count = 0 Then @@ -76,7 +69,9 @@ Function ReadForm(objTokens) Case "@" strAlias = "deref" Case Else - 'TODO + boolError = True + strError = "unknown token " & strAlias + Call REPL() End Select Set ReadForm = New MalType @@ -86,10 +81,12 @@ Function ReadForm(objTokens) ReadForm.Value.Item(0).Type = TYPE_SYMBOL ReadForm.Value.Item(0).Value = strAlias ReadForm.Value.Add ReadForm(objTokens) - 'TODO - 'ElseIf oQueue.Peek() = ")" or oQueue.Peek() = "]" or oQueue.Peek() = "}" then - ' Set read_form = Nothing - ' err.Raise vbObjectError, "read_form", "unbalanced parentheses" + ElseIf InStr(")]}", strToken) Then + Call objTokens.Dequeue() + + boolError = True + strError = "unbalanced parentheses" + Call REPL() ElseIf strToken = "^" Then Call objTokens.Dequeue() Set ReadForm = New MalType @@ -111,7 +108,9 @@ Function ReadList(objTokens) Call objTokens.Dequeue() If objTokens.Count = 0 Then - 'TODO + boolError = True + strError = "unbalanced parentheses" + Call REPL() End If Set ReadList = New MalType @@ -125,9 +124,9 @@ Function ReadList(objTokens) End With If objTokens.Dequeue() <> ")" Then - 'TODO - MsgBox "e" - 'Err.raise vbObjectError,"reader", "excepted '"+q+"', got EOF" + boolError = True + strError = "unbalanced parentheses" + Call REPL() End If End Function @@ -135,7 +134,9 @@ function ReadVector(objTokens) Call objTokens.Dequeue() If objTokens.Count = 0 Then - 'TODO + boolError = True + strError = "unbalanced parentheses" + Call REPL() End If Set ReadVector = New MalType @@ -149,17 +150,19 @@ function ReadVector(objTokens) End With If objTokens.Dequeue() <> "]" Then - 'TODO - MsgBox "e" - 'err.raise vbObjectError,"reader", "excepted '"+q+"', got EOF" + boolError = True + strError = "unbalanced parentheses" + Call REPL() End If End Function Function ReadHashmap(objTokens) Call objTokens.Dequeue() - If objTokens.Count < 2 Then - 'TODO + If objTokens.Count = 0 Then + boolError = True + strError = "unbalanced parentheses" + Call REPL() End If Set ReadHashmap = New MalType @@ -176,8 +179,9 @@ Function ReadHashmap(objTokens) End With If objTokens.Dequeue() <> "}" Then - 'TODO - 'err.raise vbObjectError,"reader", "excepted '}', got EOF" + boolError = True + strError = "unbalanced parentheses" + Call REPL() End If End Function @@ -203,8 +207,6 @@ Function ReadAtom(objTokens) objAtom.Type = TYPE_KEYWORD objAtom.Value = strAtom Case """" - 'TODO check string - 'if (not right(atom,1) = """") or len(atom) = 1 then err.raise vbObjectError,"reader", "Unterminated string, got EOF" objAtom.Type = TYPE_STRING objAtom.Value = ParseString(strAtom) Case Else @@ -223,14 +225,15 @@ End Function Function ParseString(strRaw) If Right(strRaw, 1) <> """" Or Len(strRaw) < 2 Then - MsgBox "e" + boolError = True + strError = "Unterminated string, got EOF" + Call REPL() End If Dim strTemp strTemp = Mid(strRaw, 2, Len(strRaw) - 2) Dim i i = 1 - 'Dim strChar ParseString = "" While i <= Len(strTemp) - 1 Select Case Mid(strTemp, i, 2) @@ -252,8 +255,9 @@ Function ParseString(strRaw) If Right(strTemp, 1) <> "\" Then ParseString = ParseString & Right(strTemp, 1) Else - 'TODO Error - MsgBox "err" + boolError = True + strError = "Unterminated string, got EOF" + Call REPL() End If End If End Function diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index 4fc2b3aa6f..647522d7e0 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -4,15 +4,23 @@ Include "Const.vbs" Include "Reader.vbs" Include "Printer.vbs" -Dim strCode -While True 'REPL - 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 +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) From 7c8443201133a7134c0d5a4dbeac6206ec7ff7cc Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sun, 28 Aug 2022 13:44:39 +0800 Subject: [PATCH 012/129] vbs: fix step3 --- impls/vbs/env.vbs | 66 ++++---- impls/vbs/reader.vbs | 4 +- impls/vbs/step2_eval.vbs | 243 +++++++++++++++-------------- impls/vbs/step3_env.vbs | 323 ++++++++++++++++++++++++--------------- 4 files changed, 365 insertions(+), 271 deletions(-) diff --git a/impls/vbs/env.vbs b/impls/vbs/env.vbs index 7586079e9d..f43523523b 100644 --- a/impls/vbs/env.vbs +++ b/impls/vbs/env.vbs @@ -1,32 +1,42 @@ -class enviroment - public data - private sub Class_Initialize() - set data = CreateObject("Scripting.Dictionary") - - end sub +class Environment + Private objOuterEnv + Public objBindings + Private objSelf + Private Sub Class_Initialize() + Set objBindings = CreateObject("Scripting.Dictionary") + Set objOuterEnv = Nothing + Set objSelf = Nothing + End Sub + + Public Function SetOuter(objEnv) + Set objOuterEnv = objEnv + End Function + + Public Function SetSelf(objEnv) + Set objSelf = objEnv + End Function - public sub setOuter(outer) - data.add "outer", outer - end sub + Public Sub Add(varKey, varValue) + 'objBindings.Add varKey, varValue + Set objBindings(varKey) = varValue + End Sub - public sub set_(symbolKey,malValue) - data.add symbolKey, malValue - end sub - - public function find(symbolKey) - if data.Exists(symbolKey) then - set find = data - else - if data.item("outer") = empty then - err.raise vbObjectError, "find", "not found, undefined symbol: " & symbolKey - else - set find = data.item("outer").find(symbolKey) - end if - end if - end function - - public function get_(symbolKey) - set get_ = find(symbolKey).item(symbolKey) - end function + Public Function Find(varKey) + If objBindings.Exists(varKey) Then + Set Find = objSelf + Else + If TypeName(objOuterEnv) <> "Nothing" Then + Set Find = objOuterEnv.Find(varKey) + Else + boolError = True + strError = "symbol " & varKey & " not found" + Call REPL() + End If + End If + End Function + + Public Function [Get](varKey) + Set [Get] = Find(varKey).objBindings(varKey) + End Function end class \ No newline at end of file diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs index 5437a44801..3dc1cb6228 100644 --- a/impls/vbs/reader.vbs +++ b/impls/vbs/reader.vbs @@ -226,7 +226,7 @@ End Function Function ParseString(strRaw) If Right(strRaw, 1) <> """" Or Len(strRaw) < 2 Then boolError = True - strError = "Unterminated string, got EOF" + strError = "unterminated string, got EOF" Call REPL() End If @@ -256,7 +256,7 @@ Function ParseString(strRaw) ParseString = ParseString & Right(strTemp, 1) Else boolError = True - strError = "Unterminated string, got EOF" + strError = "unterminated string, got EOF" Call REPL() End If End If diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs index 7977aad6e9..58c145eef9 100644 --- a/impls/vbs/step2_eval.vbs +++ b/impls/vbs/step2_eval.vbs @@ -1,141 +1,140 @@ -Include "reader.vbs" -Include "printer.vbs" +Option Explicit -function add(args) - set add = new MalType - add.type_ = "number" - 'msgbox typename(args) - add.value_ = args.value_.item(1).value_ + args.value_.item(2).value_ -end function +Include "Const.vbs" +Include "Reader.vbs" +Include "Printer.vbs" -function subtract(args) - set subtract = new MalType - subtract.type_ = "number" - subtract.value_ = args.value_.item(1).value_ - args.value_.item(2).value_ -end function +Dim objEnv +Set objEnv = CreateObject("Scripting.Dictionary") +objEnv.Add "+", GetRef("Add") +objEnv.Add "-", GetRef("Subtract") +objEnv.Add "*", GetRef("Multiply") +objEnv.Add "/", GetRef("Divide") -function multiply(args) - set multiply = new MalType - multiply.type_ = "number" - multiply.value_ = args.value_.item(1).value_ * args.value_.item(2).value_ -end function +Sub CheckArgNum(objArgs, lngExpect) + If objArgs.Value.Count - 1 <> 2 Then + boolError = True + strError = "wrong number of arguments" + Call REPL() + End If +End Sub -function divide(args) - set divide = new MalType - divide.type_ = "number" - divide.value_ = args.value_.item(1).value_ / args.value_.item(2).value_ -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 donothing(args) - set donothing = new MalType - donothing.type_ = "nil" - donothing.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 -class enviroment - public env - private sub Class_Initialize() - set env = CreateObject("Scripting.Dictionary") - env.add "+",getref("add") - env.add "-",getref("subtract") - env.add "*",getref("multiply") - env.add "/",getref("divide") - env.add "donothing", getref("donothing") - end sub -end class +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(str) - set READ = read_str(str) +Function Read(strCode) + Set Read = ReadString(strCode) End Function -Function EVAL(oMal,env) - 'msgbox typename(oMal) - if TypeName(oMal) = "Nothing" then - 'msgbox "nothing" - set EVAL = donothing("") - exit function - end if - select case oMal.type_ - case "list()" - if oMal.value_.count = 0 then - set EVAL = oMal - else - 'wsh.echo oMal.value_.item(0).value_ - 'wsh.echo typename(env.env) - 'msgbox eval_ast(oMal.value_.item(1),env).value_ - 'msgbox typename(env.env.item("+")(oMal)) - 'if not isempty(oMal.value_.item(0)) then - set EVAL = env.env.item(eval_ast(oMal.value_.item(0),env).value_)(eval_ast(oMal,env)) - 'else - 'end if - end if - case else - set EVAL = eval_ast(oMal,env) - end select +Function Evaluate(objCode, objEnv) + 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 + + Set Evaluate = EvaluateAST(objCode, objEnv) + Set Evaluate = Evaluate.Value.Item(0)(Evaluate) + Else + Set Evaluate = EvaluateAST(objCode, objEnv) + End If End Function -function eval_ast(ast,env) - select case ast.type_ - case "list()" - for i = 0 to ast.value_.count - 1 - set ast.value_.item(i) = EVAL(ast.value_.item(i),env) - next - set eval_ast = ast - case "symbol" - if env.env.Exists(ast.value_) then - set eval_ast = ast - else - 'err.raise vbObjectError, "eval_ast", "undefined symbol: " & ast.value_ - wsh.echo "undefined symbol: " & ast.value_ - ast.value_ = "donothing" - set eval_ast = ast - end if - case "list[]" - for i = 0 to ast.value_.count - 1 - set ast.value_.item(i) = EVAL(ast.value_.item(i),env) - next - set eval_ast = ast - case "hash-map" - For i = 0 To ast.value_.Count -1 ' 迭代数组。 - ' wsh.echo ast.value_.keys()(i).value_ - ' wsh.echo ast.value_.item(ast.value_.keys()(i)).value_ - set ast.value_.item(ast.value_.keys()(i)) = EVAL(ast.value_.item(ast.value_.keys()(i)),env) +Function EvaluateAST(objCode, objEnv) + Dim objResult, i + Select Case objCode.Type + Case TYPE_SYMBOL + If objEnv.Exists(objCode.Value) Then + Set objResult = objEnv(objCode.Value) + Else + boolError = True + strError = "symbol not found" + Call REPL() + End If + Case TYPE_LIST + For i = 0 To objCode.Value.Count - 1 + Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) Next - set eval_ast = ast - case else - set eval_ast = ast - end select -end function - - -Function PRINT(oMal) - PRINT = pr_str(oMal,true) + Set objResult = objCode + Case TYPE_VECTOR + For i = 0 To objCode.Value.Count - 1 + Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) + Next + Set objResult = objCode + Case TYPE_HASHMAP + Dim arrKeys + arrKeys = objCode.Value.Keys + For i = 0 To objCode.Value.Count - 1 + Set objCode.Value.Item(arrKeys(i)) = _ + Evaluate(objCode.Value.Item(arrKeys(i)), objEnv) + Next + Set objResult = objCode + Case Else + Set objResult = objCode + End Select + Set EvaluateAST = objResult End Function -Function rep(str,env) - 'on error resume next - rep = PRINT(EVAL(READ(str),env)) - 'msgbox 2 - if err.number <> 0 then rep = err.description - on error goto 0 +Function Print(objCode) + Print = PrintMalType(objCode, True) End Function -While True - WScript.StdOut.Write("user> ") - code = WScript.StdIn.ReadLine() - set env = new enviroment - WScript.Echo(rep(code,env)) -WEnd +Function REP(strCode) + REP = Print(Evaluate(Read(strCode), objEnv)) +End Function -Sub Include(sInstFile) - Dim oFSO, f, s - Set oFSO = CreateObject("Scripting.FileSystemObject") - sInstFile = oFSO.GetParentFolderName(oFSO.GetFile(Wscript.ScriptFullName)) & "\" & sInstFile - Set f = oFSO.OpenTextFile(sInstFile) - s = f.ReadAll - f.Close - Set f = Nothing - Set oFSO = Nothing - ExecuteGlobal s +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With End Sub \ No newline at end of file diff --git a/impls/vbs/step3_env.vbs b/impls/vbs/step3_env.vbs index 8eb674c344..e125c0f653 100644 --- a/impls/vbs/step3_env.vbs +++ b/impls/vbs/step3_env.vbs @@ -1,130 +1,215 @@ -Include "reader.vbs" -Include "printer.vbs" -Include "env.vbs" - -function add(args) - set add = new MalType - add.type_ = "number" - 'msgbox typename(args) - add.value_ = args.value_.item(1).value_ + args.value_.item(2).value_ -end function - -function subtract(args) - set subtract = new MalType - subtract.type_ = "number" - subtract.value_ = args.value_.item(1).value_ - args.value_.item(2).value_ -end function - -function multiply(args) - set multiply = new MalType - multiply.type_ = "number" - multiply.value_ = args.value_.item(1).value_ * args.value_.item(2).value_ -end function - -function divide(args) - set divide = new MalType - divide.type_ = "number" - divide.value_ = args.value_.item(1).value_ / args.value_.item(2).value_ -end function - -function donothing(args) - set donothing = new MalType - donothing.type_ = "nil" - donothing.value_ = "" -end function - - -Function READ(str) - set READ = read_str(str) +Option Explicit + +Include "Const.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" + +Dim objEnv +Set objEnv = New Environment +objEnv.SetSelf objEnv +objEnv.SetOuter Nothing +objEnv.Add "+", GetRef("Add") +objEnv.Add "-", GetRef("Subtract") +objEnv.Add "*", GetRef("Multiply") +objEnv.Add "/", GetRef("Divide") +objEnv.Add "def!", GetRef("Divide") +objEnv.Add "let*", GetRef("Divide") + + +Sub CheckArgNum(objArgs, lngExpect) + If objArgs.Value.Count - 1 <> 2 Then + boolError = True + strError = "wrong number of arguments" + Call REPL() + End If +End Sub + +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 EVAL(oMal,env) - 'msgbox typename(oMal) - if TypeName(oMal) = "Nothing" then - 'msgbox "nothing" - set EVAL = donothing("") - exit function - end if - select case oMal.type_ - case "list()" - if oMal.value_.count = 0 then - set EVAL = oMal - else - 'wsh.echo oMal.value_.item(0).value_ - 'wsh.echo typename(env.env) - 'msgbox eval_ast(oMal.value_.item(1),env).value_ - 'msgbox typename(env.env.item("+")(oMal)) - 'if not isempty(oMal.value_.item(0)) then - set EVAL = env.env.item(eval_ast(oMal.value_.item(0),env).value_)(eval_ast(oMal,env)) - 'else - 'end if - end if - case else - set EVAL = eval_ast(oMal,env) - end select +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 eval_ast(ast,env) - select case ast.type_ - case "list()" - for i = 0 to ast.value_.count - 1 - set ast.value_.item(i) = EVAL(ast.value_.item(i),env) - next - set eval_ast = ast - case "symbol" - if env.env.Exists(ast.value_) then - set eval_ast = ast - else - 'err.raise vbObjectError, "eval_ast", "undefined symbol: " & ast.value_ - wsh.echo "undefined symbol: " & ast.value_ - ast.value_ = "donothing" - set eval_ast = ast - end if - case "list[]" - for i = 0 to ast.value_.count - 1 - set ast.value_.item(i) = EVAL(ast.value_.item(i),env) - next - set eval_ast = ast - case "hash-map" - For i = 0 To ast.value_.Count -1 ' 迭代数组。 - ' wsh.echo ast.value_.keys()(i).value_ - ' wsh.echo ast.value_.item(ast.value_.keys()(i)).value_ - set ast.value_.item(ast.value_.keys()(i)) = EVAL(ast.value_.item(ast.value_.keys()(i)),env) - Next - set eval_ast = ast - case else - set eval_ast = ast - end select -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 -Function PRINT(oMal) - PRINT = pr_str(oMal,true) +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) + 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 + Set objSymbol = Evaluate(objCode.Value.Item(0), objEnv) + If TypeName(objSymbol) = "MalType" Then + 'MsgBox TypeName(objCode.value) + Select Case objSymbol.Value + Case "def!" + CheckArgNum objCode, 2 + CheckSymbol objCode.Value.Item(1) + 'MsgBox 2 + objEnv.Add objCode.Value.Item(1).Value, _ + Evaluate(objCode.Value.Item(2), objEnv) + 'MsgBox 3 + 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) + End Select + Else + Set Evaluate = objSymbol(EvaluateAST(objCode, objEnv)) + End If + Else + Set Evaluate = EvaluateAST(objCode, objEnv) + End If +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 + Select Case objCode.Value + Case "def!" + Set objResult = objCode + Case "let*" + Set objResult = objCode + Case Else + Set objResult = objEnv.Get(objCode.Value) + End Select + Case TYPE_LIST + For i = 0 To objCode.Value.Count - 1 + Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) + Next + Set objResult = objCode + Case TYPE_VECTOR + For i = 0 To objCode.Value.Count - 1 + Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) + Next + Set objResult = objCode + Case TYPE_HASHMAP + Dim arrKeys + arrKeys = objCode.Value.Keys + For i = 0 To objCode.Value.Count - 1 + Set objCode.Value.Item(arrKeys(i)) = _ + Evaluate(objCode.Value.Item(arrKeys(i)), objEnv) + Next + Set objResult = objCode + Case Else + Set objResult = objCode + End Select + Set EvaluateAST = objResult +End Function + +Function Print(objCode) + Print = PrintMalType(objCode, True) End Function -Function rep(str,env) - 'on error resume next - rep = PRINT(EVAL(READ(str),env)) - 'msgbox 2 - if err.number <> 0 then rep = err.description - on error goto 0 +Function REP(strCode) + REP = Print(Evaluate(Read(strCode), objEnv)) End Function -While True - WScript.StdOut.Write("user> ") - code = WScript.StdIn.ReadLine() - set env = new enviroment - WScript.Echo(rep(code,env)) -WEnd - -Sub Include(sInstFile) - Dim oFSO, f, s - Set oFSO = CreateObject("Scripting.FileSystemObject") - sInstFile = oFSO.GetParentFolderName(oFSO.GetFile(Wscript.ScriptFullName)) & "\" & sInstFile - Set f = oFSO.OpenTextFile(sInstFile) - s = f.ReadAll - f.Close - Set f = Nothing - Set oFSO = Nothing - ExecuteGlobal s +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With End Sub \ No newline at end of file From add135ee3289449c9432c52663d9c62247c37f05 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sun, 28 Aug 2022 15:46:30 +0800 Subject: [PATCH 013/129] vbs: step4 init: --- impls/vbs/const.vbs | 3 +++ impls/vbs/env.vbs | 14 ++++++++++++++ impls/vbs/printer.vbs | 3 +++ impls/vbs/step3_env.vbs | 2 -- 4 files changed, 20 insertions(+), 2 deletions(-) diff --git a/impls/vbs/const.vbs b/impls/vbs/const.vbs index 4790c4d2f5..7db34a14cd 100644 --- a/impls/vbs/const.vbs +++ b/impls/vbs/const.vbs @@ -7,6 +7,9 @@ Const TYPE_KEYWORD = 5 Const TYPE_STRING = 6 Const TYPE_NUMBER = 7 Const TYPE_SYMBOL = 8 +Const TYPE_FUNCTION = 9 +Const TYPE_LAMBDA = 9 +Const TYPE_SPECIAL = 10 Class MalType Public [Type] diff --git a/impls/vbs/env.vbs b/impls/vbs/env.vbs index f43523523b..240bfab0fb 100644 --- a/impls/vbs/env.vbs +++ b/impls/vbs/env.vbs @@ -9,6 +9,20 @@ class Environment Set objSelf = Nothing End Sub + Public Sub Init(objBinds, objExpressions) + 'MsgBox objExpressions.type + Dim i + For i = 0 To objBinds.Value.Count - 1 + Add objBinds.Value.Item(i).Value, _ + Evaluate(objExpressions.Value.Item(i+1), objSelf) + '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 Function SetOuter(objEnv) Set objOuterEnv = objEnv End Function diff --git a/impls/vbs/printer.vbs b/impls/vbs/printer.vbs index acb7947aca..7d28f67ec3 100644 --- a/impls/vbs/printer.vbs +++ b/impls/vbs/printer.vbs @@ -1,6 +1,7 @@ Option Explicit Function PrintMalType(objMal, boolReadable) + 'MsgBox 1 PrintMalType = "" If TypeName(objMal) = "Nothing" Then Exit Function @@ -64,6 +65,8 @@ Function PrintMalType(objMal, boolReadable) PrintMalType = "nil" Case TYPE_NUMBER PrintMalType = CStr(objMal.Value) + Case TYPE_FUNCTION + PrintMalType = "#" Case Else PrintMalType = objMal.Value End Select diff --git a/impls/vbs/step3_env.vbs b/impls/vbs/step3_env.vbs index e125c0f653..e6f27bdb52 100644 --- a/impls/vbs/step3_env.vbs +++ b/impls/vbs/step3_env.vbs @@ -13,8 +13,6 @@ objEnv.Add "+", GetRef("Add") objEnv.Add "-", GetRef("Subtract") objEnv.Add "*", GetRef("Multiply") objEnv.Add "/", GetRef("Divide") -objEnv.Add "def!", GetRef("Divide") -objEnv.Add "let*", GetRef("Divide") Sub CheckArgNum(objArgs, lngExpect) From 85e39eb8ceea6803c515ff076c1814d1909be522 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sun, 28 Aug 2022 15:47:05 +0800 Subject: [PATCH 014/129] vbs: step4 init:1 --- impls/vbs/step4_if_fn_do.vbs | 294 +++++++++++++++++++++++++++++++++++ 1 file changed, 294 insertions(+) create mode 100644 impls/vbs/step4_if_fn_do.vbs diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs new file mode 100644 index 0000000000..54f11268eb --- /dev/null +++ b/impls/vbs/step4_if_fn_do.vbs @@ -0,0 +1,294 @@ +Option Explicit + +Include "Const.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" + +Dim objEnv +Set objEnv = New Environment +objEnv.SetSelf objEnv +objEnv.SetOuter Nothing +objEnv.Add "+", NewLambda(GetRef("Add")) +objEnv.Add "-", NewLambda(GetRef("Subtract")) +objEnv.Add "*", NewLambda(GetRef("Multiply")) +objEnv.Add "/", NewLambda(GetRef("Divide")) +objEnv.Add "def!", NewSpecialForm("def!") +objEnv.Add "let*", NewSpecialForm("let*") +objEnv.Add "do", NewSpecialForm("do") +objEnv.Add "if", NewSpecialForm("if") +objEnv.Add "fn*", NewSpecialForm("fn*") + +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 + +Class BuiltInFunction + Public Run +End Class + +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 <> 2 Then + boolError = True + strError = "wrong number of arguments" + Call REPL() + End If +End Sub + +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 + + +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) + 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 + Set objSymbol = Evaluate(objCode.Value.Item(0), objEnv) + ' there's a bug that Item(0) maybe eval twice. + If IsSpecialForm(objSymbol) Then + 'MsgBox TypeName(objCode.value) + Select Case objSymbol.Value + Case "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 + If IsNil(objCondition) Or IsFalse(objCondition) Then + Select Case objCode.Value.Count - 1 + Case 2 + Set Evaluate = New MalType + Evaluate.Type = TYPE_NIL + Evaluate.Value = Null + 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 + Else + Set Evaluate = objSymbol.Value.Run(EvaluateAST(objCode, objEnv)) + End If + Else + Set Evaluate = EvaluateAST(objCode, objEnv) + End If +End Function + +Class Lambda + Public objEnv + Public objParameters + Public objBody + Public Function Run(objArgs) + 'MsgBox objArgs.type + objEnv.Init objParameters, objArgs + 'para start from 0, args start from 1 + Set Run = Evaluate(objBody, objEnv) + End Function +End Class + +Function IsFalse(objMal) + IsFalse = (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 + For i = 0 To objCode.Value.Count - 1 + Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) + Next + Set objResult = objCode + Case TYPE_VECTOR + For i = 0 To objCode.Value.Count - 1 + Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) + Next + Set objResult = objCode + Case TYPE_HASHMAP + Dim arrKeys + arrKeys = objCode.Value.Keys + For i = 0 To objCode.Value.Count - 1 + Set objCode.Value.Item(arrKeys(i)) = _ + Evaluate(objCode.Value.Item(arrKeys(i)), objEnv) + Next + Set objResult = objCode + 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), objEnv)) +End Function + +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With +End Sub \ No newline at end of file From 7af8b97f18355b4d20655076d679ebf27047136c Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sun, 28 Aug 2022 21:33:05 +0800 Subject: [PATCH 015/129] vbs: add step4(have some bugs) --- impls/vbs/const.vbs | 17 ----- impls/vbs/env.vbs | 23 +++++- impls/vbs/printer.vbs | 1 + impls/vbs/reader.vbs | 1 - impls/vbs/step1_read_print.vbs | 2 +- impls/vbs/step2_eval.vbs | 4 +- impls/vbs/step3_env.vbs | 4 +- impls/vbs/step4_if_fn_do.vbs | 129 ++++++++++++++++----------------- 8 files changed, 89 insertions(+), 92 deletions(-) delete mode 100644 impls/vbs/const.vbs diff --git a/impls/vbs/const.vbs b/impls/vbs/const.vbs deleted file mode 100644 index 7db34a14cd..0000000000 --- a/impls/vbs/const.vbs +++ /dev/null @@ -1,17 +0,0 @@ -Const TYPE_LIST = 0 -Const TYPE_VECTOR = 1 -Const TYPE_HASHMAP = 2 -Const TYPE_BOOLEAN = 3 -Const TYPE_NIL = 4 -Const TYPE_KEYWORD = 5 -Const TYPE_STRING = 6 -Const TYPE_NUMBER = 7 -Const TYPE_SYMBOL = 8 -Const TYPE_FUNCTION = 9 -Const TYPE_LAMBDA = 9 -Const TYPE_SPECIAL = 10 - -Class MalType - Public [Type] - Public Value -End Class diff --git a/impls/vbs/env.vbs b/impls/vbs/env.vbs index 240bfab0fb..a3f5099d47 100644 --- a/impls/vbs/env.vbs +++ b/impls/vbs/env.vbs @@ -11,10 +11,27 @@ class Environment Public Sub Init(objBinds, objExpressions) 'MsgBox objExpressions.type - Dim i + Dim i,flag + flag = False For i = 0 To objBinds.Value.Count - 1 - Add objBinds.Value.Item(i).Value, _ - Evaluate(objExpressions.Value.Item(i+1), objSelf) + 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)) diff --git a/impls/vbs/printer.vbs b/impls/vbs/printer.vbs index 7d28f67ec3..e99f0e3022 100644 --- a/impls/vbs/printer.vbs +++ b/impls/vbs/printer.vbs @@ -53,6 +53,7 @@ Function PrintMalType(objMal, boolReadable) If boolReadable Then PrintMalType = EscapeString(objMal.Value) Else + 'PrintMalType = """" & objMal.Value & """" PrintMalType = objMal.Value End If Case TYPE_BOOLEAN diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs index 3dc1cb6228..4497dbcd87 100644 --- a/impls/vbs/reader.vbs +++ b/impls/vbs/reader.vbs @@ -200,7 +200,6 @@ Function ReadAtom(objTokens) objAtom.Value = False Case "nil" objAtom.Type = TYPE_NIL - objAtom.Value = Null Case Else Select Case Left(strAtom, 1) Case ":" diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index 647522d7e0..3dd0901445 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -1,6 +1,6 @@ Option Explicit -Include "Const.vbs" +Include "Core.vbs" Include "Reader.vbs" Include "Printer.vbs" diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs index 58c145eef9..ba62218fa0 100644 --- a/impls/vbs/step2_eval.vbs +++ b/impls/vbs/step2_eval.vbs @@ -1,6 +1,6 @@ Option Explicit -Include "Const.vbs" +Include "Core.vbs" Include "Reader.vbs" Include "Printer.vbs" @@ -12,7 +12,7 @@ objEnv.Add "*", GetRef("Multiply") objEnv.Add "/", GetRef("Divide") Sub CheckArgNum(objArgs, lngExpect) - If objArgs.Value.Count - 1 <> 2 Then + If objArgs.Value.Count - 1 <> lngExpect Then boolError = True strError = "wrong number of arguments" Call REPL() diff --git a/impls/vbs/step3_env.vbs b/impls/vbs/step3_env.vbs index e6f27bdb52..b049384fe1 100644 --- a/impls/vbs/step3_env.vbs +++ b/impls/vbs/step3_env.vbs @@ -1,6 +1,6 @@ Option Explicit -Include "Const.vbs" +Include "Core.vbs" Include "Reader.vbs" Include "Printer.vbs" Include "Env.vbs" @@ -16,7 +16,7 @@ objEnv.Add "/", GetRef("Divide") Sub CheckArgNum(objArgs, lngExpect) - If objArgs.Value.Count - 1 <> 2 Then + If objArgs.Value.Count - 1 <> lngExpect Then boolError = True strError = "wrong number of arguments" Call REPL() diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs index 54f11268eb..3399600ae3 100644 --- a/impls/vbs/step4_if_fn_do.vbs +++ b/impls/vbs/step4_if_fn_do.vbs @@ -1,23 +1,28 @@ +'TODO ×Ö·û´®ÓÐÎÊÌâ +'TODO ¹þÏ£±íн¨Ã»Ð´ + Option Explicit -Include "Const.vbs" +Include "Core.vbs" Include "Reader.vbs" Include "Printer.vbs" Include "Env.vbs" -Dim objEnv -Set objEnv = New Environment -objEnv.SetSelf objEnv -objEnv.SetOuter Nothing -objEnv.Add "+", NewLambda(GetRef("Add")) -objEnv.Add "-", NewLambda(GetRef("Subtract")) -objEnv.Add "*", NewLambda(GetRef("Multiply")) -objEnv.Add "/", NewLambda(GetRef("Divide")) -objEnv.Add "def!", NewSpecialForm("def!") -objEnv.Add "let*", NewSpecialForm("let*") -objEnv.Add "do", NewSpecialForm("do") -objEnv.Add "if", NewSpecialForm("if") -objEnv.Add "fn*", NewSpecialForm("fn*") +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 @@ -28,10 +33,6 @@ Function NewLambda(objFunction) Set NewLambda = objMal End Function -Class BuiltInFunction - Public Run -End Class - Function NewSpecialForm(strValue) Set NewSpecialForm = New MalType NewSpecialForm.Value = strValue @@ -47,42 +48,13 @@ Class SpecialForm End Class Sub CheckArgNum(objArgs, lngExpect) - If objArgs.Value.Count - 1 <> 2 Then + If objArgs.Value.Count - 1 <> lngExpect Then boolError = True strError = "wrong number of arguments" Call REPL() End If End Sub -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 - - Call REPL() Sub REPL() Dim strCode, strResult @@ -118,7 +90,6 @@ Function Evaluate(objCode, objEnv) Dim objSymbol Set objSymbol = Evaluate(objCode.Value.Item(0), objEnv) - ' there's a bug that Item(0) maybe eval twice. If IsSpecialForm(objSymbol) Then 'MsgBox TypeName(objCode.value) Select Case objSymbol.Value @@ -152,12 +123,14 @@ Function Evaluate(objCode, objEnv) '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 - Evaluate.Value = Null Case 3 Set Evaluate = Evaluate(objCode.Value.Item(3), objEnv) Case Else @@ -184,27 +157,53 @@ Function Evaluate(objCode, objEnv) 'MsgBox 1 End Select Else + 'MsgBox 2 + 'objSymbol.Value.SetEnv objEnv Set Evaluate = objSymbol.Value.Run(EvaluateAST(objCode, objEnv)) + 'MsgBox objEnv.Get("N").value + 'MsgBox 3 End If Else Set Evaluate = EvaluateAST(objCode, objEnv) End If End Function +Class BuiltInFunction + Public Run + Public Sub SetEnv(z) + End Sub +End Class + Class Lambda - Public objEnv Public objParameters Public objBody + Public objEnv + 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 - objEnv.Init objParameters, objArgs + objNewEnv.Init objParameters, objArgs 'para start from 0, args start from 1 - Set Run = Evaluate(objBody, objEnv) + 'MsgBox objNewEnv.Get("N").value + Set Run = Evaluate(objBody, objNewEnv) 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.Value = False) + IsFalse = (objMal.Type = TYPE_BOOLEAN) + If Not IsFalse Then Exit Function + IsFalse = IsFalse And (objMal.Value = False) End Function Function IsNil(objMal) @@ -253,23 +252,21 @@ Function EvaluateAST(objCode, objEnv) 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 - Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) + objResult.Value.Add Evaluate(objCode.Value.Item(i), objEnv) Next - Set objResult = objCode 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 - Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) + objResult.Value.Add Evaluate(objCode.Value.Item(i), objEnv) Next - Set objResult = objCode Case TYPE_HASHMAP - Dim arrKeys - arrKeys = objCode.Value.Keys - For i = 0 To objCode.Value.Count - 1 - Set objCode.Value.Item(arrKeys(i)) = _ - Evaluate(objCode.Value.Item(arrKeys(i)), objEnv) - Next - Set objResult = objCode + 'TODO: new hashMap Case Else Set objResult = objCode End Select @@ -281,7 +278,7 @@ Function Print(objCode) End Function Function REP(strCode) - REP = Print(Evaluate(Read(strCode), objEnv)) + REP = Print(Evaluate(Read(strCode), objRootEnv)) End Function Sub Include(strFileName) From 4c96d741c42b489f99aa1497dc73f82f98148ee5 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sun, 28 Aug 2022 21:36:38 +0800 Subject: [PATCH 016/129] vbs: core miss, added --- impls/vbs/core.vbs | 243 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 243 insertions(+) create mode 100644 impls/vbs/core.vbs diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs new file mode 100644 index 0000000000..949cea4ecb --- /dev/null +++ b/impls/vbs/core.vbs @@ -0,0 +1,243 @@ +Const TYPE_LIST = 0 +Const TYPE_VECTOR = 1 +Const TYPE_HASHMAP = 2 +Const TYPE_BOOLEAN = 3 +Const TYPE_NIL = 4 +Const TYPE_KEYWORD = 5 +Const TYPE_STRING = 6 +Const TYPE_NUMBER = 7 +Const TYPE_SYMBOL = 8 +Const TYPE_FUNCTION = 9 +Const TYPE_LAMBDA = 9 +Const TYPE_SPECIAL = 10 + +Class MalType + Public [Type] + Public Value +End Class + +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 + + +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 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 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 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 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 + +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 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 + + +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 + + +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 + +Sub Er(sInfo) + boolError = True + strError = sInfo +End Sub + +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 \ No newline at end of file From 223727e799c9cac2d3578079606c84cef5ebb752 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sun, 23 Oct 2022 12:47:04 +0800 Subject: [PATCH 017/129] vbs: fix fn* calling bug which evaluate code twice --- impls/vbs/core.vbs | 27 ++++++++++++++++- impls/vbs/step0_repl.vbs | 2 +- impls/vbs/step2_eval.vbs | 2 +- impls/vbs/step3_env.vbs | 2 +- impls/vbs/step4_if_fn_do.vbs | 56 ++++++++++++++++++++++++++++++++++-- 5 files changed, 83 insertions(+), 6 deletions(-) diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index 949cea4ecb..23ed3abe11 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -35,7 +35,32 @@ objCoreNS.Add "pr-str", GetRef("mprstr") 'all 'ret str 'readable 'concat by spac 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") +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 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 mprintln(objArgs) Dim objRes,i @@ -239,5 +264,5 @@ 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 + Divide.Value = objArgs.Value.Item(1).Value \ objArgs.Value.Item(2).Value End Function \ No newline at end of file diff --git a/impls/vbs/step0_repl.vbs b/impls/vbs/step0_repl.vbs index bc9d6e3283..862e690e6b 100644 --- a/impls/vbs/step0_repl.vbs +++ b/impls/vbs/step0_repl.vbs @@ -24,4 +24,4 @@ While True 'REPL If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 WScript.Echo REP(strCode) -WEnd +Wend diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs index ba62218fa0..bc5123ada3 100644 --- a/impls/vbs/step2_eval.vbs +++ b/impls/vbs/step2_eval.vbs @@ -44,7 +44,7 @@ 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 + Divide.Value = objArgs.Value.Item(1).Value \ objArgs.Value.Item(2).Value End Function diff --git a/impls/vbs/step3_env.vbs b/impls/vbs/step3_env.vbs index b049384fe1..2a5d0b23e5 100644 --- a/impls/vbs/step3_env.vbs +++ b/impls/vbs/step3_env.vbs @@ -48,7 +48,7 @@ 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 + Divide.Value = objArgs.Value.Item(1).Value \ objArgs.Value.Item(2).Value End Function diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs index 3399600ae3..6922cfcadf 100644 --- a/impls/vbs/step4_if_fn_do.vbs +++ b/impls/vbs/step4_if_fn_do.vbs @@ -2,7 +2,10 @@ 'TODO ¹þÏ£±íн¨Ã»Ð´ Option Explicit - +Dim DEPTH +DEPTH = 0 +Dim CALLFROM +CALLFROM = "" Include "Core.vbs" Include "Reader.vbs" Include "Printer.vbs" @@ -76,7 +79,9 @@ 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() @@ -89,11 +94,16 @@ Function Evaluate(objCode, objEnv) 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 "ÎÒÔÚdef" CheckArgNum objCode, 2 CheckSymbol objCode.Value.Item(1) objEnv.Add objCode.Value.Item(1).Value, _ @@ -156,19 +166,53 @@ Function Evaluate(objCode, objEnv) 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 - Set Evaluate = objSymbol.Value.Run(EvaluateAST(objCode, 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) + + 'ÕâÀïÓдóÎÊÌâ + If objSymbol.Value.IsBuiltIn Then + 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 @@ -178,6 +222,10 @@ 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 @@ -191,7 +239,11 @@ Class Lambda 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 From 03c59c82ab8f8ca5765d4596f08b73a651b37b16 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sun, 30 Oct 2022 20:20:57 +0800 Subject: [PATCH 018/129] vbs: fix env's big bug Env binding should happen in function calling --- .gitignore | 1 + impls/vbs/core.vbs | 19 +++++++++++++++ impls/vbs/reader.vbs | 46 ++++++++++++++++++------------------ impls/vbs/step4_if_fn_do.vbs | 33 ++++++++++++++++---------- 4 files changed, 64 insertions(+), 35 deletions(-) diff --git a/.gitignore b/.gitignore index 7ecfa581fb..d1e4a10b77 100644 --- a/.gitignore +++ b/.gitignore @@ -21,3 +21,4 @@ GRTAGS logs old tmp/ +impls/\#batch/* diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index 23ed3abe11..3bbb5124bf 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -37,6 +37,25 @@ objCoreNS.Add "prn", GetRef("mprn") 'all 'to screen ret nil 'concat by space 're 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 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 + +Function mFirst(objArgs) + 'Set objRes = New MalType + Set objRes = objArgs.value.item(1).value.item(0) + Set mFirst= objRes + 'msgbox 1 +End Function Function mGet(objArgs) Set objRes = New MalType diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs index 4497dbcd87..2902a451f3 100644 --- a/impls/vbs/reader.vbs +++ b/impls/vbs/reader.vbs @@ -8,11 +8,11 @@ Function Tokenize(strCode) Dim objRE Set objRE = New RegExp With objRE - .Pattern = "[\s,]*(~@|[\[\]{}()'`~^@]|""(?:\\.|[^\\""])*""?|;.*|[^\s\[\]{}('""`,;)]*)" + .Pattern = "[\s,]*(~@|[\[\]{}()'`~^@]|""(?:\\.|[^\\""])*""?|;.*|[^\s\[\]{}('""`,;)]*)" .IgnoreCase = True .Global = True End With - + Dim objTokens, objMatches, objMatch Set objTokens = CreateObject("System.Collections.Queue") Set objMatches = objRE.Execute(strCode) @@ -23,7 +23,7 @@ Function Tokenize(strCode) objTokens.Enqueue strToken End If Next - + Set Tokenize = objTokens End Function @@ -34,16 +34,16 @@ Function ReadForm(objTokens) Set ReadForm = Nothing Exit Function End If - + If objTokens.Count = 1 And objTokens.Peek() = "" Then Call objTokens.Dequeue() Set ReadForm = Nothing Exit Function End If - + Dim strToken strToken = objTokens.Peek() - + If InStr("([{", strToken) Then Select Case strToken Case "(" @@ -55,7 +55,7 @@ Function ReadForm(objTokens) End Select ElseIf InStr("'`~@", strToken) Then Call objTokens.Dequeue() - + Dim strAlias Select Case strToken Case "'" @@ -73,7 +73,7 @@ Function ReadForm(objTokens) strError = "unknown token " & strAlias Call REPL() End Select - + Set ReadForm = New MalType ReadForm.Type = TYPE_LIST Set ReadForm.Value = CreateObject("System.Collections.ArrayList") @@ -83,7 +83,7 @@ Function ReadForm(objTokens) ReadForm.Value.Add ReadForm(objTokens) ElseIf InStr(")]}", strToken) Then Call objTokens.Dequeue() - + boolError = True strError = "unbalanced parentheses" Call REPL() @@ -106,13 +106,13 @@ End Function Function ReadList(objTokens) Call objTokens.Dequeue() - + If objTokens.Count = 0 Then boolError = True strError = "unbalanced parentheses" Call REPL() End If - + Set ReadList = New MalType Set ReadList.Value = CreateObject("System.Collections.ArrayList") ReadList.Type = TYPE_LIST @@ -122,7 +122,7 @@ Function ReadList(objTokens) .Add ReadForm(objTokens) Wend End With - + If objTokens.Dequeue() <> ")" Then boolError = True strError = "unbalanced parentheses" @@ -132,23 +132,23 @@ End Function function ReadVector(objTokens) Call objTokens.Dequeue() - + If objTokens.Count = 0 Then boolError = True strError = "unbalanced parentheses" Call REPL() End If - + Set ReadVector = New MalType Set ReadVector.Value = CreateObject("System.Collections.ArrayList") ReadVector.Type = TYPE_VECTOR - + With ReadVector.Value While objTokens.Count > 1 And objTokens.Peek() <> "]" .Add ReadForm(objTokens) Wend End With - + If objTokens.Dequeue() <> "]" Then boolError = True strError = "unbalanced parentheses" @@ -158,7 +158,7 @@ End Function Function ReadHashmap(objTokens) Call objTokens.Dequeue() - + If objTokens.Count = 0 Then boolError = True strError = "unbalanced parentheses" @@ -168,7 +168,7 @@ Function ReadHashmap(objTokens) Set ReadHashmap = New MalType Set ReadHashmap.Value = CreateObject("Scripting.Dictionary") ReadHashmap.Type = TYPE_HASHMAP - + Dim objKey, objValue With ReadHashmap.Value While objTokens.Count > 2 And objTokens.Peek() <> "}" @@ -177,7 +177,7 @@ Function ReadHashmap(objTokens) .Add objKey, objValue Wend End With - + If objTokens.Dequeue() <> "}" Then boolError = True strError = "unbalanced parentheses" @@ -188,7 +188,7 @@ End Function Function ReadAtom(objTokens) Dim strAtom strAtom = objTokens.Dequeue() - + Dim objAtom Set objAtom = New MalType Select Case strAtom @@ -218,7 +218,7 @@ Function ReadAtom(objTokens) End If End Select End Select - + Set ReadAtom = objAtom End Function @@ -228,7 +228,7 @@ Function ParseString(strRaw) strError = "unterminated string, got EOF" Call REPL() End If - + Dim strTemp strTemp = Mid(strRaw, 2, Len(strRaw) - 2) Dim i @@ -248,7 +248,7 @@ Function ParseString(strRaw) End Select i = i + 2 Wend - + If i <= Len(strTemp) Then ' Last char is not processed. If Right(strTemp, 1) <> "\" Then diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs index 6922cfcadf..73ccc70c2c 100644 --- a/impls/vbs/step4_if_fn_do.vbs +++ b/impls/vbs/step4_if_fn_do.vbs @@ -1,5 +1,4 @@ 'TODO ×Ö·û´®ÓÐÎÊÌâ -'TODO ¹þÏ£±íн¨Ã»Ð´ Option Explicit Dim DEPTH @@ -86,13 +85,13 @@ Function Evaluate(objCode, objEnv) 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) @@ -159,9 +158,9 @@ Function Evaluate(objCode, objEnv) 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.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 @@ -175,10 +174,14 @@ Function Evaluate(objCode, objEnv) '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) - + 'ÕâÀïÓдóÎÊÌâ If objSymbol.Value.IsBuiltIn Then + Set objSymbol.Value.objEnv = New Environment + objSymbol.Value.objEnv.SetSelf objSymbol.Value.objEnv + objSymbol.Value.objEnv.SetOuter objEnv Set Evaluate = objSymbol.Value.Run(objCode) + Else Set Evaluate = objSymbol.Value.Run(EvaluateAST(objCode, objEnv)) End If @@ -229,7 +232,7 @@ Class Lambda Public Function SetEnv(oInv) Set objEnv=oInv End Function - + Public Function Run(objArgs) Dim objNewEnv Set objNewEnv = New Environment @@ -267,7 +270,7 @@ Sub CheckEven(lngNum) boolError = True strError = "not a even number" Call REPL() - End If + End If End Sub Sub CheckList(objMal) @@ -298,7 +301,7 @@ Function EvaluateAST(objCode, objEnv) If TypeName(objCode) = "Nothing" Then MsgBox "Nothing2" End If - + Dim objResult, i Select Case objCode.Type Case TYPE_SYMBOL @@ -318,7 +321,13 @@ Function EvaluateAST(objCode, objEnv) objResult.Value.Add Evaluate(objCode.Value.Item(i), objEnv) Next Case TYPE_HASHMAP - 'TODO: new 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 @@ -340,4 +349,4 @@ Sub Include(strFileName) .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With -End Sub \ No newline at end of file +End Sub From 76d4c8f79f8f391cceaece905615006060622c20 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sun, 30 Oct 2022 20:55:17 +0800 Subject: [PATCH 019/129] vbs: env hotfix combine env(when fn created) and running env into one --- impls/vbs/.step4_if_fn_do.vbs.swp | Bin 0 -> 24576 bytes impls/vbs/step4_if_fn_do.vbs | 12 +++++++----- 2 files changed, 7 insertions(+), 5 deletions(-) create mode 100644 impls/vbs/.step4_if_fn_do.vbs.swp diff --git a/impls/vbs/.step4_if_fn_do.vbs.swp b/impls/vbs/.step4_if_fn_do.vbs.swp new file mode 100644 index 0000000000000000000000000000000000000000..12430fdb5ea61e6e5578d783524559f9a220f618 GIT binary patch literal 24576 zcmeI33yfS>d4MlXLNW#1kc3Eu2CgTGJ!3ZGS869|9kP#Edz9Us&F*>^P{Enqx$B*H zcJ4BdwH>uU8>0qF1rZ4W5h4U32_(>fN=TZbnh;u0c$NwkB#Kbu1PiQ2Es>(AYWn@> zaUU~xc5M_?>O&jy?sHxJ~7}p$G`j4 z=j8i(f90`}vC{taayib(HCs1Mc`d)wT<}_3r@R%vRcrgr8b6jR^{ut#m3nLI>U?W! ztL?2^d7!pK8~_UwE1$wLoft{uWqRxq9cW4bILT+qYes-RNF;!D&p`{?gJX zsRdFCq!vgmkXj(MKx%>10;vU33;aK{KzrqE=SB4X9e6Li%y2fJgaDlPncwH|IRX!x z-)HezgXhg}KGMI`0;vU33#1lEEs$CuwLoft)B>pmQVXOONG*_B;J4HQm8w?kDhU8^ z|1U9sXMWFdo`xU7x8QO365I#3!@Hmcb1(~gVH2DOzue$BKY=IUKJeg1*a2t5k6-0D z55X~*gIU-GTi|^7`70?4pMl%p7~BFCcoV!HUU-G$oPuA%x8UROLHGdt8TjBq6|RE| z;KkpiJ@5@U4v)Z>;Q{yr+zNjRORyWV@cZz5#&LcIe-9smKL-yEz#PoNo8S#_0lXT{ zhg0X#R`>xt2zSGW;SOlQ4X_(F!6onq@Jjgib7?yqg&ScHTmb*^a>w}|9Ebbhub>Kl z2Tspyx!KxcHmuUt5veX(jeTs=hW$>X?Ox$-HXgD@ zwd$JOd0q8@d%y}DUh)^K8^_x;0wA&7JYxLSQ0yn%96_)4QUk?vL(n z)HP{Qs*>WW*H|m7t|3xjtk!Cmo3q{mFC!%vjAR~c9-Qcyp&`9v^b4&(mzFziPf5bm zx@he2v{zr0dbHVe1~Ynf61L!rOX*tEZ!CKa(=BF9M#|~&Q1{wfl1Bu!Af>R^YbT9~ z?WUW|U<~`5V#9vi&}RIEgU5)LPEW{gMF%4w+W(39*SE1(B8QxbM zzTO=zO-;}6??h>OpVVcBh?zrcuWs97tJ`VSBvqIJrmK)eURH?GB40AaBek|W+G#Av z8ZQZ5OPA?Wo?sL6!>m7gMyvU)Hh@S5=>$gm%v&al2gXV?R~gL->m9Dt>+V!>ax6#B zP_Vn#@|4a_`0b@y<6zd9Tv}0cGOE{jtUp=49IJk?g$ zv9zdVK2n19sxa5Au~B9_Ew6d4o0W25-_QGgU8}gqRr@+mgC3u;4l$0C@^X2uB8m?DbEhjVCnXlItTy+p}RGJ%EKDtL=sTFxhFN=6tW(v`HW0s@H zV2l;BWsDx-&}JKnNKX>!a3qN3QEHPc!IE189)Y7TX3^>(R| zl&`BHc5xJCZ1zx5Wo5HE(j=z1o6WI9ZFC!c+s!RDwz#=U-p$n*e(s{2jomh*EuYV4 z9aNw4{kCk>vYTefoE;F+k?zT<)O=4~&Z50pN$kzZp|Lk7iM=`1aiTY`O76`qjZBg( z$$3XFHeD^OG@I9ZM_aiXyHwECV!>g*=}k=QGh~=4&(Mw@5%&*qimv8NhP-3G=pHvB zM7|?yig`HT)}pp!H0VQ`**dzO*%O-S7RL-8^V1BB=<&>KoHoBxYAn<{Rapz^RNi0D zhAETmARG_7Qf0;NNtCwee8YodW1~~$ajMQ{Rl978W4F0&Dp~z<$}6%?4J1CozFaY?^BO_@#(wXd-BfDpZw%U9P$6fC)|Y(DgJ+rk5l;ZKY}OWt8g6d zhh=yhOhOrU!3OvRe*IVAA^02k2&_U4mS75Y!)0(5Jcplu3QoXN@Ev#%J_-%E5#9`w zP=@XBEPnq_;A`+D_#Av1?t%Bi66}Yo;f-)9ybfLqzrz3jHarSnfQR62I0o;45!eYA z!FTZa9|DO7?1Ssz3fKVO$Y2L}H(Uo-!DVm`{1d+Wz3?&UfcWzl!Fg~B|NUq11bi7D zhPy$0{5l+h{ctH<46lLz7M~tI3m0fGr)B>pme)ATPL$`8o$+D@d;Cqx{dZ zW&Mn^iJaZdMlHwDK<(~RxE$v8xN6_d1!1w6!>9a5v-!(u#T*3Vo?e${spMI?94h6s ztj|CaRuWevB1l)RPDtW*c8QYXiB*iyAwtP%94O_+>5zzYgFVS8?@DJBPnJh2UQ*;> zD%pZiU?9l&LUKU0RpkzOM+47!AWSxDni4A7O3qkBA|nU7Vr5~;hy*h za;zeQXcQ_E^?mjYPVXBZoa|{?aK`U997bv?kWpzKWgsNjMSKI(DLhuTQ9+7Gg{Nnu zc*B%2L4zj-Sp)~ctKocw#@t}@ob!8HAr@uBjV_^+{urJ4xJdA2^Mp3CCHL_%Zc z3dKghb`Z@ty#QITJlTnyc-?SDAr^6RD{f1L_t%Q5i2JSPFOd{ApR@_OVktWQD2pNa z&1x5HH!2+2KiH!+smplA*8QS8J$k6%;~=}4t~9Qs9_w97MsE#%O;tTEH3;xkTv3-m zfqY$MUi!^5*Ih-_f@qW|_iHMpdeW0S6df_^s|t}Yxd|EftL~04NU3&J6%mtrn4Hek zvty}iL*|LmF&5RCD2+vSzTko}913>)GT!wyBZBNV=|U^i#(7l8l9|Wsz}*kBs*q|| zSlfz8)@-O;9xDz`#Iy_UIg|9WvHw!*tzOd?edV)XyZ4U|6{p(mAeh*Lo}@|;W_dDZ^>|nkAExv{{SD);?w^lJOXz>8x~d(NB;YaW__yXJx?}o#02=>Dm48b5=39p9@ z@Zwp-2H<<}75H2DFdTzb=)fH8h0Ebw_yu?G{{j!fF{r?$@B;sFjUOp62YH$U@Pdo)Y4dQ8p-1#Z7_sB3eDfY%KEFQ%F zNTQK3(LA&9KdmoM&9PbkX8!WUrCj8C)X4E#Rn4(`3%;i#~xLVrQZiBu>=?>&~xkxrjsz15Qan_n9 z#hLw66Ks6aAa&jdX8_?>hBRA=oildtGIw=dzO2ZA}0An+=E>DN!7l@U&& z1R1-}R7StrvYu=qc-Gm0tZW?FfuMew^kxj(G)ANSns~O<7G#tKM_o#si2+T~nEkrM ztz$l$JJ=bqo=uY$q0lusB^oE3XY)oK8wgg*u(ku~QF{1{Dd{JAF%}(dgCq2?kKdFMUSH?2% zTgC%@-1B-;|EzW+Opp{PC8b5d7NbWZc8%2p^>pp3OqHOH&L=Nh)nLW>e=3hE0MdR&%?z82hUDXwR#LW|4>th9EFXqjty($3}T0 zCi-}1u!@A^*l4cfZbn(grn)5OwIQ1l3yDi3y6w4ED|W`Cyi!`pQ=7E>3ddHo_lSPj z>bq-`VH4{;BT@I4DAyZC)N?1WhY@YV0Na)Se?2~~kKZf){|F!dihqAMv|t#9;2L-i zpI+|z<&OU*xEy|fFMlumHPqn%6yS1r13ZmCFL(6wa3P$)kN+$zLKeP{@BTQ5Uwy`;eW8jakvwdUBs4BxHF8Z zBuF^Jpi2M91uMrIF_knp%j;(Ns?r12+qE|y>vUp}Jr)}aQco|)9%K)N^o@>rl4q?e xifFi^D>A|;hy~96uY)o31n@6%q+Kn)#xPGikntd_hF`J~x_rHbqV6p%J literal 0 HcmV?d00001 diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs index 73ccc70c2c..0fc5a1c771 100644 --- a/impls/vbs/step4_if_fn_do.vbs +++ b/impls/vbs/step4_if_fn_do.vbs @@ -158,9 +158,9 @@ Function Evaluate(objCode, objEnv) 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.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 @@ -177,9 +177,11 @@ Function Evaluate(objCode, objEnv) 'ÕâÀïÓдóÎÊÌâ If objSymbol.Value.IsBuiltIn Then - Set objSymbol.Value.objEnv = New Environment + dim oldenv + set oldenv = objSymbol.Value.objEnv + Set objSymbol.Value.objEnv = objEnv objSymbol.Value.objEnv.SetSelf objSymbol.Value.objEnv - objSymbol.Value.objEnv.SetOuter objEnv + objSymbol.Value.objEnv.SetOuter oldEnv Set Evaluate = objSymbol.Value.Run(objCode) Else From 805b8140ee7bd36e21abe9b3748e0fa870bbe4d5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Fri, 23 Dec 2022 23:40:24 +0800 Subject: [PATCH 020/129] vbs: rewrite codes --- impls/vbs/.step4_if_fn_do.vbs.swp | Bin 24576 -> 0 bytes impls/vbs/core.vbs | 149 ++++++++++++-- impls/vbs/printer.vbs | 77 ++++---- impls/vbs/reader.vbs | 313 ++++++++++++++++-------------- impls/vbs/step1_read_print.vbs | 19 +- 5 files changed, 357 insertions(+), 201 deletions(-) delete mode 100644 impls/vbs/.step4_if_fn_do.vbs.swp diff --git a/impls/vbs/.step4_if_fn_do.vbs.swp b/impls/vbs/.step4_if_fn_do.vbs.swp deleted file mode 100644 index 12430fdb5ea61e6e5578d783524559f9a220f618..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 24576 zcmeI33yfS>d4MlXLNW#1kc3Eu2CgTGJ!3ZGS869|9kP#Edz9Us&F*>^P{Enqx$B*H zcJ4BdwH>uU8>0qF1rZ4W5h4U32_(>fN=TZbnh;u0c$NwkB#Kbu1PiQ2Es>(AYWn@> zaUU~xc5M_?>O&jy?sHxJ~7}p$G`j4 z=j8i(f90`}vC{taayib(HCs1Mc`d)wT<}_3r@R%vRcrgr8b6jR^{ut#m3nLI>U?W! ztL?2^d7!pK8~_UwE1$wLoft{uWqRxq9cW4bILT+qYes-RNF;!D&p`{?gJX zsRdFCq!vgmkXj(MKx%>10;vU33;aK{KzrqE=SB4X9e6Li%y2fJgaDlPncwH|IRX!x z-)HezgXhg}KGMI`0;vU33#1lEEs$CuwLoft)B>pmQVXOONG*_B;J4HQm8w?kDhU8^ z|1U9sXMWFdo`xU7x8QO365I#3!@Hmcb1(~gVH2DOzue$BKY=IUKJeg1*a2t5k6-0D z55X~*gIU-GTi|^7`70?4pMl%p7~BFCcoV!HUU-G$oPuA%x8UROLHGdt8TjBq6|RE| z;KkpiJ@5@U4v)Z>;Q{yr+zNjRORyWV@cZz5#&LcIe-9smKL-yEz#PoNo8S#_0lXT{ zhg0X#R`>xt2zSGW;SOlQ4X_(F!6onq@Jjgib7?yqg&ScHTmb*^a>w}|9Ebbhub>Kl z2Tspyx!KxcHmuUt5veX(jeTs=hW$>X?Ox$-HXgD@ zwd$JOd0q8@d%y}DUh)^K8^_x;0wA&7JYxLSQ0yn%96_)4QUk?vL(n z)HP{Qs*>WW*H|m7t|3xjtk!Cmo3q{mFC!%vjAR~c9-Qcyp&`9v^b4&(mzFziPf5bm zx@he2v{zr0dbHVe1~Ynf61L!rOX*tEZ!CKa(=BF9M#|~&Q1{wfl1Bu!Af>R^YbT9~ z?WUW|U<~`5V#9vi&}RIEgU5)LPEW{gMF%4w+W(39*SE1(B8QxbM zzTO=zO-;}6??h>OpVVcBh?zrcuWs97tJ`VSBvqIJrmK)eURH?GB40AaBek|W+G#Av z8ZQZ5OPA?Wo?sL6!>m7gMyvU)Hh@S5=>$gm%v&al2gXV?R~gL->m9Dt>+V!>ax6#B zP_Vn#@|4a_`0b@y<6zd9Tv}0cGOE{jtUp=49IJk?g$ zv9zdVK2n19sxa5Au~B9_Ew6d4o0W25-_QGgU8}gqRr@+mgC3u;4l$0C@^X2uB8m?DbEhjVCnXlItTy+p}RGJ%EKDtL=sTFxhFN=6tW(v`HW0s@H zV2l;BWsDx-&}JKnNKX>!a3qN3QEHPc!IE189)Y7TX3^>(R| zl&`BHc5xJCZ1zx5Wo5HE(j=z1o6WI9ZFC!c+s!RDwz#=U-p$n*e(s{2jomh*EuYV4 z9aNw4{kCk>vYTefoE;F+k?zT<)O=4~&Z50pN$kzZp|Lk7iM=`1aiTY`O76`qjZBg( z$$3XFHeD^OG@I9ZM_aiXyHwECV!>g*=}k=QGh~=4&(Mw@5%&*qimv8NhP-3G=pHvB zM7|?yig`HT)}pp!H0VQ`**dzO*%O-S7RL-8^V1BB=<&>KoHoBxYAn<{Rapz^RNi0D zhAETmARG_7Qf0;NNtCwee8YodW1~~$ajMQ{Rl978W4F0&Dp~z<$}6%?4J1CozFaY?^BO_@#(wXd-BfDpZw%U9P$6fC)|Y(DgJ+rk5l;ZKY}OWt8g6d zhh=yhOhOrU!3OvRe*IVAA^02k2&_U4mS75Y!)0(5Jcplu3QoXN@Ev#%J_-%E5#9`w zP=@XBEPnq_;A`+D_#Av1?t%Bi66}Yo;f-)9ybfLqzrz3jHarSnfQR62I0o;45!eYA z!FTZa9|DO7?1Ssz3fKVO$Y2L}H(Uo-!DVm`{1d+Wz3?&UfcWzl!Fg~B|NUq11bi7D zhPy$0{5l+h{ctH<46lLz7M~tI3m0fGr)B>pme)ATPL$`8o$+D@d;Cqx{dZ zW&Mn^iJaZdMlHwDK<(~RxE$v8xN6_d1!1w6!>9a5v-!(u#T*3Vo?e${spMI?94h6s ztj|CaRuWevB1l)RPDtW*c8QYXiB*iyAwtP%94O_+>5zzYgFVS8?@DJBPnJh2UQ*;> zD%pZiU?9l&LUKU0RpkzOM+47!AWSxDni4A7O3qkBA|nU7Vr5~;hy*h za;zeQXcQ_E^?mjYPVXBZoa|{?aK`U997bv?kWpzKWgsNjMSKI(DLhuTQ9+7Gg{Nnu zc*B%2L4zj-Sp)~ctKocw#@t}@ob!8HAr@uBjV_^+{urJ4xJdA2^Mp3CCHL_%Zc z3dKghb`Z@ty#QITJlTnyc-?SDAr^6RD{f1L_t%Q5i2JSPFOd{ApR@_OVktWQD2pNa z&1x5HH!2+2KiH!+smplA*8QS8J$k6%;~=}4t~9Qs9_w97MsE#%O;tTEH3;xkTv3-m zfqY$MUi!^5*Ih-_f@qW|_iHMpdeW0S6df_^s|t}Yxd|EftL~04NU3&J6%mtrn4Hek zvty}iL*|LmF&5RCD2+vSzTko}913>)GT!wyBZBNV=|U^i#(7l8l9|Wsz}*kBs*q|| zSlfz8)@-O;9xDz`#Iy_UIg|9WvHw!*tzOd?edV)XyZ4U|6{p(mAeh*Lo}@|;W_dDZ^>|nkAExv{{SD);?w^lJOXz>8x~d(NB;YaW__yXJx?}o#02=>Dm48b5=39p9@ z@Zwp-2H<<}75H2DFdTzb=)fH8h0Ebw_yu?G{{j!fF{r?$@B;sFjUOp62YH$U@Pdo)Y4dQ8p-1#Z7_sB3eDfY%KEFQ%F zNTQK3(LA&9KdmoM&9PbkX8!WUrCj8C)X4E#Rn4(`3%;i#~xLVrQZiBu>=?>&~xkxrjsz15Qan_n9 z#hLw66Ks6aAa&jdX8_?>hBRA=oildtGIw=dzO2ZA}0An+=E>DN!7l@U&& z1R1-}R7StrvYu=qc-Gm0tZW?FfuMew^kxj(G)ANSns~O<7G#tKM_o#si2+T~nEkrM ztz$l$JJ=bqo=uY$q0lusB^oE3XY)oK8wgg*u(ku~QF{1{Dd{JAF%}(dgCq2?kKdFMUSH?2% zTgC%@-1B-;|EzW+Opp{PC8b5d7NbWZc8%2p^>pp3OqHOH&L=Nh)nLW>e=3hE0MdR&%?z82hUDXwR#LW|4>th9EFXqjty($3}T0 zCi-}1u!@A^*l4cfZbn(grn)5OwIQ1l3yDi3y6w4ED|W`Cyi!`pQ=7E>3ddHo_lSPj z>bq-`VH4{;BT@I4DAyZC)N?1WhY@YV0Na)Se?2~~kKZf){|F!dihqAMv|t#9;2L-i zpI+|z<&OU*xEy|fFMlumHPqn%6yS1r13ZmCFL(6wa3P$)kN+$zLKeP{@BTQ5Uwy`;eW8jakvwdUBs4BxHF8Z zBuF^Jpi2M91uMrIF_knp%j;(Ns?r12+qE|y>vUp}Jr)}aQco|)9%K)N^o@>rl4q?e xifFi^D>A|;hy~96uY)o31n@6%q+Kn)#xPGikntd_hF`J~x_rHbqV6p%J diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index 3bbb5124bf..0aa22908a4 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -1,21 +1,144 @@ -Const TYPE_LIST = 0 -Const TYPE_VECTOR = 1 -Const TYPE_HASHMAP = 2 -Const TYPE_BOOLEAN = 3 -Const TYPE_NIL = 4 -Const TYPE_KEYWORD = 5 -Const TYPE_STRING = 6 -Const TYPE_NUMBER = 7 -Const TYPE_SYMBOL = 8 -Const TYPE_FUNCTION = 9 -Const TYPE_LAMBDA = 9 -Const TYPE_SPECIAL = 10 +Option Explicit + +Dim TYPES +Set TYPES = New MalTypes +Class MalTypes + Public LIST, VECTOR, HASHMAP, [BOOLEAN], NIL + Public KEYWORD, [STRING], NUMBER, SYMBOL + Public LAMBDA, PROCEDURE + + Public [TypeName] + Private Sub Class_Initialize + [TypeName] = Array( _ + "LIST", "VECTOR", "HASHMAP", "BOOLEAN", _ + "NIL", "KEYWORD", "STRING", "NUMBER", _ + "SYMBOL", "LAMBDA", "PROCEDURE") + + Dim i + For i = 0 To UBound([TypeName]) + Execute "[" + [TypeName](i) + "] = " + CStr(i+10) + Next + End Sub +End Class Class MalType Public [Type] Public Value End Class +Function NewMalType(lngType, varValue) + Dim varResult + Set varResult = New MalType + With varResult + .Type = lngType + .Value = Wrap(varValue) + End With + Set NewMalType = varResult +End Function + +Function Wrap(varValue) + Wrap = Array(varValue) +End Function + +Function Unwrap(varValue) + If IsObject(varValue(0)) Then + Set Unwrap = varValue(0) + Else + Unwrap = varValue(0) + End If +End Function + +Function ValueOf(objMalType) + If IsObject(Unwrap(objMalType.Value)) Then + Set ValueOf = Unwrap(objMalType.Value) + Else + ValueOf = Unwrap(objMalType.Value) + End If +End Function + +Class MalList + Public [Type] + Public Value + + Public Function Add(objMalType) + Unwrap(Value).Add objMalType + End Function + + Public Function Item(i) + Set Item = Unwrap(Value).Item(i) + End Function + + Public Function Count() + Count = Unwrap(Value).Count + End Function +End Class + +Function NewMalList(arrValues) + Dim varResult + Set varResult = New MalList + With varResult + .Type = TYPES.LIST + .Value = Wrap(CreateObject("System.Collections.ArrayList")) + + Dim i + For i = 0 To UBound(arrValues) + .Add arrValues(i) + Next + End With + Set NewMalList = varResult +End Function + +Function NewMalVector(arrValues) + Dim varResult + Set varResult = New MalList + With varResult + .Type = TYPES.VECTOR + .Value = Wrap(CreateObject("System.Collections.ArrayList")) + + Dim i + For i = 0 To UBound(arrValues) + .Add arrValues(i) + Next + End With + Set NewMalVector = varResult +End Function + +Class MalHashmap + Public [Type] + Public Value + + Public Function Add(varKey, varValue) + Unwrap(Value).Add varKey, varValue + End Function + + Public Property Get Keys() + Keys = Unwrap(Value).Keys + End Property + + Public Function Count() + Count = Unwrap(Value).Count + End Function + + Public Function Item(varKey) + Set Item = Unwrap(Value).Item(varKey) + End Function +End Class + +Function NewMalHashmap(arrKeys, arrValues) + Dim varResult + Set varResult = New MalHashmap + With varResult + .Type = TYPES.HASHMAP + .Value = Wrap(CreateObject("Scripting.Dictionary")) + + Dim i + For i = 0 To UBound(arrKeys) + .Add arrKeys(i), arrValues(i) + Next + End With + Set NewMalHashmap = varResult +End Function + Public objCoreNS Set objCoreNS = CreateObject("Scripting.Dictionary") objCoreNS.Add "+", GetRef("Add") @@ -284,4 +407,4 @@ Function Divide(objArgs) Set Divide = New MalType Divide.Type = TYPE_NUMBER Divide.Value = objArgs.Value.Item(1).Value \ objArgs.Value.Item(2).Value -End Function \ No newline at end of file +End Function diff --git a/impls/vbs/printer.vbs b/impls/vbs/printer.vbs index e99f0e3022..27e9268aef 100644 --- a/impls/vbs/printer.vbs +++ b/impls/vbs/printer.vbs @@ -1,76 +1,87 @@ Option Explicit Function PrintMalType(objMal, boolReadable) - 'MsgBox 1 - PrintMalType = "" + Dim varResult + + varResult = "" + If TypeName(objMal) = "Nothing" Then + PrintMalType = "" Exit Function End If Dim i Select Case objMal.Type - Case TYPE_LIST - With objMal.Value + Case TYPES.LIST + With ValueOf(objMal) For i = 0 To .Count - 2 - PrintMalType = PrintMalType & _ + varResult = varResult & _ PrintMalType(.Item(i), boolReadable) & " " Next If .Count > 0 Then - PrintMalType = PrintMalType & _ + varResult = varResult & _ PrintMalType(.Item(.Count - 1), boolReadable) End If End With - PrintMalType = "(" & PrintMalType & ")" - Case TYPE_VECTOR - With objMal.Value + varResult = "(" & varResult & ")" + Case TYPES.VECTOR + With ValueOf(objMal) For i = 0 To .Count - 2 - PrintMalType = PrintMalType & _ + varResult = varResult & _ PrintMalType(.Item(i), boolReadable) & " " Next If .Count > 0 Then - PrintMalType = PrintMalType & _ + varResult = varResult & _ PrintMalType(.Item(.Count - 1), boolReadable) End If End With - PrintMalType = "[" & PrintMalType & "]" - Case TYPE_HASHMAP - With objMal.Value + varResult = "[" & varResult & "]" + Case TYPES.HASHMAP + With ValueOf(objMal) Dim arrKeys arrKeys = .Keys For i = 0 To .Count - 2 - PrintMalType = PrintMalType & _ + varResult = varResult & _ PrintMalType(arrKeys(i), boolReadable) & " " & _ PrintMalType(.Item(arrKeys(i)), boolReadable) & " " Next If .Count > 0 Then - PrintMalType = PrintMalType & _ + varResult = varResult & _ PrintMalType(arrKeys(.Count - 1), boolReadable) & " " & _ PrintMalType(.Item(arrKeys(.Count - 1)), boolReadable) End If End With - PrintMalType = "{" & PrintMalType & "}" - Case TYPE_STRING + varResult = "{" & varResult & "}" + Case TYPES.STRING If boolReadable Then - PrintMalType = EscapeString(objMal.Value) + varResult = EscapeString(ValueOf(objMal)) Else - 'PrintMalType = """" & objMal.Value & """" - PrintMalType = objMal.Value + varResult = ValueOf(objMal) End If - Case TYPE_BOOLEAN - If objMal.Value Then - PrintMalType = "true" + Case TYPES.BOOLEAN + If ValueOf(objMal) Then + varResult = "true" Else - PrintMalType = "false" + varResult = "false" End If - Case TYPE_NIL - PrintMalType = "nil" - Case TYPE_NUMBER - PrintMalType = CStr(objMal.Value) - Case TYPE_FUNCTION - PrintMalType = "#" + Case TYPES.NIL + varResult = "nil" + Case TYPES.NUMBER + varResult = CStr(ValueOf(objMal)) + Case TYPES.LAMBDA + varResult = "#" + Case TYPES.PROCEDURE + varResult = "#" + Case TYPES.KEYWORD + varResult = ValueOf(objMal) + Case TYPES.SYMBOL + varResult = ValueOf(objMal) Case Else - PrintMalType = objMal.Value + Err.Raise vbObjectError, _ + "PrintMalType", "unknown type" End Select + + PrintMalType = varResult End Function Function EscapeString(strRaw) @@ -79,4 +90,4 @@ Function EscapeString(strRaw) EscapeString = Replace(EscapeString, vbCrLf, "\n") EscapeString = Replace(EscapeString, """", "\""") EscapeString = """" & EscapeString & """" -End Function \ No newline at end of file +End Function diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs index 2902a451f3..e9f69348c9 100644 --- a/impls/vbs/reader.vbs +++ b/impls/vbs/reader.vbs @@ -4,229 +4,249 @@ Function ReadString(strCode) Set ReadString = ReadForm(Tokenize(strCode)) End Function -Function Tokenize(strCode) - Dim objRE - Set objRE = New RegExp - With objRE - .Pattern = "[\s,]*(~@|[\[\]{}()'`~^@]|""(?:\\.|[^\\""])*""?|;.*|[^\s\[\]{}('""`,;)]*)" - .IgnoreCase = True - .Global = True - End With - - Dim objTokens, objMatches, objMatch - Set objTokens = CreateObject("System.Collections.Queue") - Set objMatches = objRE.Execute(strCode) - Dim strToken - For Each objMatch In objMatches - strToken = objMatch.SubMatches(0) - If Not Left(strToken, 1) = ";" Then - objTokens.Enqueue strToken - End If - Next - - Set Tokenize = objTokens +Class Tokens + Private strRaw, objTokens + Private objRE + + Private Sub Class_Initialize + Set objRE = New RegExp + With objRE + .Pattern = "[\s,]*(~@|[\[\]{}()'`~^@]|""(?:\\.|[^\\""])*""?|;.*|[^\s\[\]{}('""`,;)]*)" + .IgnoreCase = True + .Global = True + End With + + Set objTokens = CreateObject("System.Collections.Queue") + End Sub + + Public Function Init(strCode) + strRaw = 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 + ' Drop comments + objTokens.Enqueue Trim(strToken) + End If + Next + End Function + + Public Function Current() + Current = objTokens.Peek() + End Function + + Public Function MoveToNext() + MoveToNext = objTokens.Dequeue() + End Function + + Public Function AtEnd() + AtEnd = (objTokens.Count = 0) + End Function + + Public Function Count() + Count = objTokens.Count + End Function +End Class + +Function Tokenize(strCode) ' Return objTokens + Dim varResult + Set varResult = New Tokens + varResult.Init strCode + Set Tokenize = varResult End Function -Public boolError, strError - -Function ReadForm(objTokens) - If objTokens.Count = 0 Then - Set ReadForm = Nothing - Exit Function - End If - - If objTokens.Count = 1 And objTokens.Peek() = "" Then - Call objTokens.Dequeue() +Function ReadForm(objTokens) ' Return Nothing / MalType + If objTokens.AtEnd() Then Set ReadForm = Nothing Exit Function End If Dim strToken - strToken = objTokens.Peek() + strToken = objTokens.Current() + Dim varResult If InStr("([{", strToken) Then Select Case strToken Case "(" - Set ReadForm = ReadList(objTokens) + Set varResult = ReadList(objTokens) Case "[" - Set ReadForm = ReadVector(objTokens) + Set varResult = ReadVector(objTokens) Case "{" - Set ReadForm = ReadHashmap(objTokens) + Set varResult = ReadHashmap(objTokens) End Select ElseIf InStr("'`~@", strToken) Then - Call objTokens.Dequeue() - - Dim strAlias - Select Case strToken - Case "'" - strAlias = "quote" - Case "`" - strAlias = "quasiquote" - Case "~" - strAlias = "unquote" - Case "~@" - strAlias = "splice-unquote" - Case "@" - strAlias = "deref" - Case Else - boolError = True - strError = "unknown token " & strAlias - Call REPL() - End Select - - Set ReadForm = New MalType - ReadForm.Type = TYPE_LIST - Set ReadForm.Value = CreateObject("System.Collections.ArrayList") - ReadForm.Value.Add New MalType - ReadForm.Value.Item(0).Type = TYPE_SYMBOL - ReadForm.Value.Item(0).Value = strAlias - ReadForm.Value.Add ReadForm(objTokens) + Set varResult = ReadSpecial(objTokens) ElseIf InStr(")]}", strToken) Then - Call objTokens.Dequeue() - - boolError = True - strError = "unbalanced parentheses" - Call REPL() + Err.Raise vbObjectError, _ + "ReadForm", "unbalanced parentheses" ElseIf strToken = "^" Then - Call objTokens.Dequeue() - Set ReadForm = New MalType - ReadForm.Type = TYPE_LIST - Set ReadForm.Value = CreateObject("System.Collections.ArrayList") - ReadForm.Value.Add New MalType - ReadForm.Value.Item(0).Type = TYPE_SYMBOL - ReadForm.Value.Item(0).Value = "with-meta" - Dim objTemp - Set objTemp = ReadForm(objTokens) - ReadForm.Value.Add ReadForm(objTokens) - ReadForm.Value.Add objTemp + Set varResult = ReadMetadata(objTokens) Else - Set ReadForm = ReadAtom(objTokens) + Set varResult = ReadAtom(objTokens) + End If + + If Not objTokens.AtEnd() Then + 'Err.Raise vbObjectError, _ + ' "ReadForm", "extra token(s): " + objTokens.Current() End If + + Set ReadForm = varResult +End Function + +Function ReadMetadata(objTokens) + Dim varResult + + Call objTokens.MoveToNext() + Dim objTmp + Set objTmp = ReadForm(objTokens) + Set varResult = NewMalList(Array( _ + NewMalType(TYPES.SYMBOL, "with-meta"), _ + ReadForm(objTokens), objTmp)) + + 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( _ + NewMalType(TYPES.SYMBOL, strAlias), _ + ReadForm(objTokens))) + Set ReadSpecial = varResult End Function Function ReadList(objTokens) - Call objTokens.Dequeue() + Dim varResult + Call objTokens.MoveToNext() - If objTokens.Count = 0 Then - boolError = True - strError = "unbalanced parentheses" - Call REPL() + If objTokens.AtEnd() Then + Err.Raise vbObjectError, _ + "ReadList", "unbalanced parentheses" End If - Set ReadList = New MalType - Set ReadList.Value = CreateObject("System.Collections.ArrayList") - ReadList.Type = TYPE_LIST - - With ReadList.Value - While objTokens.Count > 1 And objTokens.Peek() <> ")" + Set varResult = NewMalList(Array()) + With varResult + While objTokens.Count() > 1 And objTokens.Current() <> ")" .Add ReadForm(objTokens) Wend End With - If objTokens.Dequeue() <> ")" Then - boolError = True - strError = "unbalanced parentheses" - Call REPL() + If objTokens.MoveToNext() <> ")" Then + Err.Raise vbObjectError, _ + "ReadList", "unbalanced parentheses" End If + + Set ReadList = varResult End Function -function ReadVector(objTokens) - Call objTokens.Dequeue() +Function ReadVector(objTokens) + Dim varResult + Call objTokens.MoveToNext() - If objTokens.Count = 0 Then - boolError = True - strError = "unbalanced parentheses" - Call REPL() + If objTokens.AtEnd() Then + Err.Raise vbObjectError, _ + "ReadVector", "unbalanced parentheses" End If - Set ReadVector = New MalType - Set ReadVector.Value = CreateObject("System.Collections.ArrayList") - ReadVector.Type = TYPE_VECTOR - - With ReadVector.Value - While objTokens.Count > 1 And objTokens.Peek() <> "]" + Set varResult = NewMalVector(Array()) + With varResult + While objTokens.Count() > 1 And objTokens.Current() <> "]" .Add ReadForm(objTokens) Wend End With - If objTokens.Dequeue() <> "]" Then - boolError = True - strError = "unbalanced parentheses" - Call REPL() + If objTokens.MoveToNext() <> "]" Then + Err.Raise vbObjectError, _ + "ReadVector", "unbalanced parentheses" End If + + Set ReadVector = varResult End Function Function ReadHashmap(objTokens) - Call objTokens.Dequeue() + Dim varResult + Call objTokens.MoveToNext() If objTokens.Count = 0 Then - boolError = True - strError = "unbalanced parentheses" - Call REPL() + Err.Raise vbObjectError, _ + "ReadHashmap", "unbalanced parentheses" End If - - Set ReadHashmap = New MalType - Set ReadHashmap.Value = CreateObject("Scripting.Dictionary") - ReadHashmap.Type = TYPE_HASHMAP + Set varResult = NewMalHashmap(Array(), Array()) Dim objKey, objValue - With ReadHashmap.Value - While objTokens.Count > 2 And objTokens.Peek() <> "}" + 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.Dequeue() <> "}" Then - boolError = True - strError = "unbalanced parentheses" - Call REPL() + 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.Dequeue() + strAtom = objTokens.MoveToNext() - Dim objAtom - Set objAtom = New MalType Select Case strAtom Case "true" - objAtom.Type = TYPE_BOOLEAN - objAtom.Value = True + Set varResult = NewMalType(TYPES.BOOLEAN, True) Case "false" - objAtom.Type = TYPE_BOOLEAN - objAtom.Value = False + Set varResult = NewMalType(TYPES.BOOLEAN, False) Case "nil" - objAtom.Type = TYPE_NIL + Set varResult = NewMalType(TYPES.NIL, Empty) Case Else Select Case Left(strAtom, 1) Case ":" - objAtom.Type = TYPE_KEYWORD - objAtom.Value = strAtom + Set varResult = NewMalType(TYPES.KEYWORD, strAtom) Case """" - objAtom.Type = TYPE_STRING - objAtom.Value = ParseString(strAtom) + Set varResult = NewMalType(TYPES.STRING, ParseString(strAtom)) Case Else If IsNumeric(strAtom) Then - objAtom.Type = TYPE_NUMBER - objAtom.Value = Eval(strAtom) + Set varResult = NewMalType(TYPES.NUMBER, Eval(strAtom)) Else - objAtom.Type = TYPE_SYMBOL - objAtom.Value = strAtom + Set varResult = NewMalType(TYPES.SYMBOL, strAtom) End If End Select End Select - Set ReadAtom = objAtom + Set ReadAtom = varResult End Function Function ParseString(strRaw) If Right(strRaw, 1) <> """" Or Len(strRaw) < 2 Then - boolError = True - strError = "unterminated string, got EOF" - Call REPL() + Err.Raise vbObjectError, _ + "ParseString", "unterminated string, got EOF" End If Dim strTemp @@ -254,9 +274,8 @@ Function ParseString(strRaw) If Right(strTemp, 1) <> "\" Then ParseString = ParseString & Right(strTemp, 1) Else - boolError = True - strError = "unterminated string, got EOF" - Call REPL() + Err.Raise vbObjectError, _ + "ParseString", "unterminated string, got EOF" End If End If End Function diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index 3dd0901445..5570663a6c 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -9,16 +9,19 @@ 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 + strCode = WScript.StdIn.ReadLine() + If Err.Number <> 0 Then WScript.Quit 0 + On Error Goto 0 + + On Error Resume Next + WScript.Echo REP(strCode) + If Err.Number <> 0 Then + WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + End If On Error Goto 0 - WScript.Echo REP(strCode) Wend End Sub @@ -45,4 +48,4 @@ Sub Include(strFileName) .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With -End Sub \ No newline at end of file +End Sub From 0677b18de564ee60810df28a73bd0fb710517bbb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 19 Jan 2023 16:13:48 +0800 Subject: [PATCH 021/129] vbs: rewrite step0 & 1 --- impls/vbs/step0_repl.vbs | 5 +++-- impls/vbs/step1_read_print.vbs | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/impls/vbs/step0_repl.vbs b/impls/vbs/step0_repl.vbs index 862e690e6b..c965e39539 100644 --- a/impls/vbs/step0_repl.vbs +++ b/impls/vbs/step0_repl.vbs @@ -20,8 +20,9 @@ Dim strCode While True 'REPL WScript.StdOut.Write("user> ") On Error Resume Next - strCode = WScript.StdIn.ReadLine() - If Err.Number <> 0 Then WScript.Quit 0 + strCode = WScript.StdIn.ReadLine() + If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 + WScript.Echo REP(strCode) Wend diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index 5570663a6c..454042bb97 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -7,7 +7,7 @@ Include "Printer.vbs" Call REPL() Sub REPL() - Dim strCode, strResult + Dim strCode While True WScript.StdOut.Write("user> ") @@ -48,4 +48,4 @@ Sub Include(strFileName) .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With -End Sub +End Sub \ No newline at end of file From 2d4a7888f86dbfab1445769003dd70076de3122f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 19 Jan 2023 19:27:04 +0800 Subject: [PATCH 022/129] vbs: new file 'types.vbs' & fix bugs & rewrite --- impls/vbs/core.vbs | 681 +++++++++++++-------------------- impls/vbs/install.vbs | 3 + impls/vbs/printer.vbs | 18 +- impls/vbs/reader.vbs | 94 ++--- impls/vbs/step1_read_print.vbs | 2 +- impls/vbs/types.vbs | 249 ++++++++++++ 6 files changed, 588 insertions(+), 459 deletions(-) create mode 100644 impls/vbs/install.vbs create mode 100644 impls/vbs/types.vbs diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index 0aa22908a4..15512e2d36 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -1,410 +1,281 @@ -Option Explicit - -Dim TYPES -Set TYPES = New MalTypes -Class MalTypes - Public LIST, VECTOR, HASHMAP, [BOOLEAN], NIL - Public KEYWORD, [STRING], NUMBER, SYMBOL - Public LAMBDA, PROCEDURE - - Public [TypeName] - Private Sub Class_Initialize - [TypeName] = Array( _ - "LIST", "VECTOR", "HASHMAP", "BOOLEAN", _ - "NIL", "KEYWORD", "STRING", "NUMBER", _ - "SYMBOL", "LAMBDA", "PROCEDURE") - - Dim i - For i = 0 To UBound([TypeName]) - Execute "[" + [TypeName](i) + "] = " + CStr(i+10) - Next - End Sub -End Class - -Class MalType - Public [Type] - Public Value -End Class - -Function NewMalType(lngType, varValue) - Dim varResult - Set varResult = New MalType - With varResult - .Type = lngType - .Value = Wrap(varValue) - End With - Set NewMalType = varResult -End Function - -Function Wrap(varValue) - Wrap = Array(varValue) -End Function - -Function Unwrap(varValue) - If IsObject(varValue(0)) Then - Set Unwrap = varValue(0) - Else - Unwrap = varValue(0) - End If -End Function - -Function ValueOf(objMalType) - If IsObject(Unwrap(objMalType.Value)) Then - Set ValueOf = Unwrap(objMalType.Value) - Else - ValueOf = Unwrap(objMalType.Value) - End If -End Function - -Class MalList - Public [Type] - Public Value - - Public Function Add(objMalType) - Unwrap(Value).Add objMalType - End Function - - Public Function Item(i) - Set Item = Unwrap(Value).Item(i) - End Function - - Public Function Count() - Count = Unwrap(Value).Count - End Function -End Class - -Function NewMalList(arrValues) - Dim varResult - Set varResult = New MalList - With varResult - .Type = TYPES.LIST - .Value = Wrap(CreateObject("System.Collections.ArrayList")) - - Dim i - For i = 0 To UBound(arrValues) - .Add arrValues(i) - Next - End With - Set NewMalList = varResult -End Function - -Function NewMalVector(arrValues) - Dim varResult - Set varResult = New MalList - With varResult - .Type = TYPES.VECTOR - .Value = Wrap(CreateObject("System.Collections.ArrayList")) - - Dim i - For i = 0 To UBound(arrValues) - .Add arrValues(i) - Next - End With - Set NewMalVector = varResult -End Function - -Class MalHashmap - Public [Type] - Public Value - - Public Function Add(varKey, varValue) - Unwrap(Value).Add varKey, varValue - End Function - - Public Property Get Keys() - Keys = Unwrap(Value).Keys - End Property - - Public Function Count() - Count = Unwrap(Value).Count - End Function - - Public Function Item(varKey) - Set Item = Unwrap(Value).Item(varKey) - End Function -End Class - -Function NewMalHashmap(arrKeys, arrValues) - Dim varResult - Set varResult = New MalHashmap - With varResult - .Type = TYPES.HASHMAP - .Value = Wrap(CreateObject("Scripting.Dictionary")) - - Dim i - For i = 0 To UBound(arrKeys) - .Add arrKeys(i), arrValues(i) - Next +Include "Types.vbs" + +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll End With - Set NewMalHashmap = varResult -End Function - -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 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 - -Function mFirst(objArgs) - 'Set objRes = New MalType - Set objRes = objArgs.value.item(1).value.item(0) - Set mFirst= objRes - 'msgbox 1 -End Function - -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 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 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 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 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 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 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 - -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 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 - - -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 +End Sub -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 +' 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 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 + +' Function mFirst(objArgs) +' 'Set objRes = New MalType +' Set objRes = objArgs.value.item(1).value.item(0) +' Set mFirst= objRes +' 'msgbox 1 +' End Function + +' 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 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 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 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 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 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 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 + +' 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 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 + + +' 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 + + +' 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) +' '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 - -Sub Er(sInfo) - boolError = True - strError = sInfo -End Sub - -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 +' 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 + +' Sub Er(sInfo) +' boolError = True +' strError = sInfo +' End Sub + +' 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 diff --git a/impls/vbs/install.vbs b/impls/vbs/install.vbs new file mode 100644 index 0000000000..a66409b0c1 --- /dev/null +++ b/impls/vbs/install.vbs @@ -0,0 +1,3 @@ +On Error Resume Next +With CreateObject("System.Collections.ArrayList") +End With \ No newline at end of file diff --git a/impls/vbs/printer.vbs b/impls/vbs/printer.vbs index 27e9268aef..84b13c7ff9 100644 --- a/impls/vbs/printer.vbs +++ b/impls/vbs/printer.vbs @@ -13,7 +13,7 @@ Function PrintMalType(objMal, boolReadable) Dim i Select Case objMal.Type Case TYPES.LIST - With ValueOf(objMal) + With objMal For i = 0 To .Count - 2 varResult = varResult & _ PrintMalType(.Item(i), boolReadable) & " " @@ -25,7 +25,7 @@ Function PrintMalType(objMal, boolReadable) End With varResult = "(" & varResult & ")" Case TYPES.VECTOR - With ValueOf(objMal) + With objMal For i = 0 To .Count - 2 varResult = varResult & _ PrintMalType(.Item(i), boolReadable) & " " @@ -37,7 +37,7 @@ Function PrintMalType(objMal, boolReadable) End With varResult = "[" & varResult & "]" Case TYPES.HASHMAP - With ValueOf(objMal) + With objMal Dim arrKeys arrKeys = .Keys For i = 0 To .Count - 2 @@ -54,12 +54,12 @@ Function PrintMalType(objMal, boolReadable) varResult = "{" & varResult & "}" Case TYPES.STRING If boolReadable Then - varResult = EscapeString(ValueOf(objMal)) + varResult = EscapeString(objMal.Value) Else - varResult = ValueOf(objMal) + varResult = objMal.Value End If Case TYPES.BOOLEAN - If ValueOf(objMal) Then + If objMal.Value Then varResult = "true" Else varResult = "false" @@ -67,15 +67,15 @@ Function PrintMalType(objMal, boolReadable) Case TYPES.NIL varResult = "nil" Case TYPES.NUMBER - varResult = CStr(ValueOf(objMal)) + varResult = CStr(objMal.Value) Case TYPES.LAMBDA varResult = "#" Case TYPES.PROCEDURE varResult = "#" Case TYPES.KEYWORD - varResult = ValueOf(objMal) + varResult = objMal.Value Case TYPES.SYMBOL - varResult = ValueOf(objMal) + varResult = objMal.Value Case Else Err.Raise vbObjectError, _ "PrintMalType", "unknown type" diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs index e9f69348c9..f258ca0a52 100644 --- a/impls/vbs/reader.vbs +++ b/impls/vbs/reader.vbs @@ -1,53 +1,63 @@ Option Explicit Function ReadString(strCode) - Set ReadString = ReadForm(Tokenize(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 strRaw, objTokens + Private objQueue Private objRE Private Sub Class_Initialize Set objRE = New RegExp With objRE - .Pattern = "[\s,]*(~@|[\[\]{}()'`~^@]|""(?:\\.|[^\\""])*""?|;.*|[^\s\[\]{}('""`,;)]*)" + .Pattern = "[\s,]*" + _ + "(" + _ + "~@" + "|" + _ + "[\[\]{}()'`~^@]" + "|" + _ + """(?:\\.|[^\\""])*""?" + "|" + _ + ";.*" + "|" + _ + "[^\s\[\]{}('""`,;)]*" + _ + ")" .IgnoreCase = True .Global = True End With - Set objTokens = CreateObject("System.Collections.Queue") + Set objQueue = CreateObject("System.Collections.Queue") End Sub Public Function Init(strCode) - strRaw = 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 - ' Drop comments - objTokens.Enqueue Trim(strToken) + objQueue.Enqueue strToken End If Next End Function Public Function Current() - Current = objTokens.Peek() + Current = objQueue.Peek() End Function Public Function MoveToNext() - MoveToNext = objTokens.Dequeue() + MoveToNext = objQueue.Dequeue() End Function Public Function AtEnd() - AtEnd = (objTokens.Count = 0) + AtEnd = (objQueue.Count = 0) End Function Public Function Count() - Count = objTokens.Count + Count = objQueue.Count End Function End Class @@ -81,18 +91,13 @@ Function ReadForm(objTokens) ' Return Nothing / MalType Set varResult = ReadSpecial(objTokens) ElseIf InStr(")]}", strToken) Then Err.Raise vbObjectError, _ - "ReadForm", "unbalanced parentheses" + "ReadForm", "Unbalanced parentheses." ElseIf strToken = "^" Then Set varResult = ReadMetadata(objTokens) Else Set varResult = ReadAtom(objTokens) End If - If Not objTokens.AtEnd() Then - 'Err.Raise vbObjectError, _ - ' "ReadForm", "extra token(s): " + objTokens.Current() - End If - Set ReadForm = varResult End Function @@ -100,11 +105,11 @@ Function ReadMetadata(objTokens) Dim varResult Call objTokens.MoveToNext() - Dim objTmp - Set objTmp = ReadForm(objTokens) + Dim objTemp + Set objTemp = ReadForm(objTokens) Set varResult = NewMalList(Array( _ - NewMalType(TYPES.SYMBOL, "with-meta"), _ - ReadForm(objTokens), objTmp)) + NewMalSym("with-meta"), _ + ReadForm(objTokens), objTemp)) Set ReadMetadata = varResult End Function @@ -127,13 +132,14 @@ Function ReadSpecial(objTokens) strAlias = "deref" Case Else Err.Raise vbObjectError, _ - "ReadSpecial", "unknown token " & strAlias + "ReadSpecial", "Unknown token '" & strAlias & "'." End Select Call objTokens.MoveToNext() Set varResult = NewMalList(Array( _ - NewMalType(TYPES.SYMBOL, strAlias), _ + NewMalSym(strAlias), _ ReadForm(objTokens))) + Set ReadSpecial = varResult End Function @@ -143,7 +149,7 @@ Function ReadList(objTokens) If objTokens.AtEnd() Then Err.Raise vbObjectError, _ - "ReadList", "unbalanced parentheses" + "ReadList", "Unbalanced parentheses." End If Set varResult = NewMalList(Array()) @@ -155,7 +161,7 @@ Function ReadList(objTokens) If objTokens.MoveToNext() <> ")" Then Err.Raise vbObjectError, _ - "ReadList", "unbalanced parentheses" + "ReadList", "Unbalanced parentheses." End If Set ReadList = varResult @@ -167,10 +173,10 @@ Function ReadVector(objTokens) If objTokens.AtEnd() Then Err.Raise vbObjectError, _ - "ReadVector", "unbalanced parentheses" + "ReadVector", "Unbalanced parentheses." End If - Set varResult = NewMalVector(Array()) + Set varResult = NewMalVec(Array()) With varResult While objTokens.Count() > 1 And objTokens.Current() <> "]" .Add ReadForm(objTokens) @@ -179,7 +185,7 @@ Function ReadVector(objTokens) If objTokens.MoveToNext() <> "]" Then Err.Raise vbObjectError, _ - "ReadVector", "unbalanced parentheses" + "ReadVector", "Unbalanced parentheses." End If Set ReadVector = varResult @@ -191,10 +197,10 @@ Function ReadHashmap(objTokens) If objTokens.Count = 0 Then Err.Raise vbObjectError, _ - "ReadHashmap", "unbalanced parentheses" + "ReadHashmap", "Unbalanced parentheses." End If - Set varResult = NewMalHashmap(Array(), Array()) - + + Set varResult = NewMalMap(Array(), Array()) Dim objKey, objValue With varResult While objTokens.Count > 2 And objTokens.Current() <> "}" @@ -203,12 +209,12 @@ Function ReadHashmap(objTokens) .Add objKey, objValue Wend End With - + If objTokens.MoveToNext() <> "}" Then Err.Raise vbObjectError, _ - "ReadHashmap", "unbalanced parentheses" + "ReadHashmap", "Unbalanced parentheses." End If - + Set ReadHashmap = varResult End Function @@ -220,22 +226,22 @@ Function ReadAtom(objTokens) Select Case strAtom Case "true" - Set varResult = NewMalType(TYPES.BOOLEAN, True) + Set varResult = NewMalBool(True) Case "false" - Set varResult = NewMalType(TYPES.BOOLEAN, False) + Set varResult = NewMalBool(False) Case "nil" - Set varResult = NewMalType(TYPES.NIL, Empty) + Set varResult = NewMalNil() Case Else Select Case Left(strAtom, 1) Case ":" - Set varResult = NewMalType(TYPES.KEYWORD, strAtom) + Set varResult = NewMalKwd(strAtom) Case """" - Set varResult = NewMalType(TYPES.STRING, ParseString(strAtom)) + Set varResult = NewMalStr(ParseString(strAtom)) Case Else If IsNumeric(strAtom) Then - Set varResult = NewMalType(TYPES.NUMBER, Eval(strAtom)) + Set varResult = NewMalNum(Eval(strAtom)) Else - Set varResult = NewMalType(TYPES.SYMBOL, strAtom) + Set varResult = NewMalSym(strAtom) End If End Select End Select @@ -246,7 +252,7 @@ End Function Function ParseString(strRaw) If Right(strRaw, 1) <> """" Or Len(strRaw) < 2 Then Err.Raise vbObjectError, _ - "ParseString", "unterminated string, got EOF" + "ParseString", "Unterminated string, got EOF." End If Dim strTemp @@ -275,7 +281,7 @@ Function ParseString(strRaw) ParseString = ParseString & Right(strTemp, 1) Else Err.Raise vbObjectError, _ - "ParseString", "unterminated string, got EOF" + "ParseString", "Unterminated string, got EOF." End If End If End Function diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index 454042bb97..314754787c 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -1,6 +1,6 @@ Option Explicit -Include "Core.vbs" +Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs new file mode 100644 index 0000000000..929db9f7ef --- /dev/null +++ b/impls/vbs/types.vbs @@ -0,0 +1,249 @@ +Option Explicit + +Dim TYPES +Set TYPES = New MalTypes + +Class MalTypes + Public LIST, VECTOR, HASHMAP, [BOOLEAN], NIL + Public KEYWORD, [STRING], NUMBER, SYMBOL + Public LAMBDA, PROCEDURE + + Public [TypeName] + Private Sub Class_Initialize + [TypeName] = Array( _ + "LIST", "VECTOR", "HASHMAP", "BOOLEAN", _ + "NIL", "KEYWORD", "STRING", "NUMBER", _ + "SYMBOL", "LAMBDA", "PROCEDURE") + + Dim i + For i = 0 To UBound([TypeName]) + Execute "[" + [TypeName](i) + "] = " + CStr(i) + Next + End Sub +End Class + +Class MalType + Public [Type] + Public Value + + Public Function Init(lngType, varValue) + [Type] = lngType + Value = varValue + End Function + + Public Function Copy() + 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, Null) +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 MalList ' Extends MalType + Public [Type] + Public Value + + 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 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 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 + + Public Function Add(varKey, varValue) + Value.Add varKey, varValue + End Function + + Public Property Get Keys() + Keys = Value.Keys + End Property + + Public Function Count() + Count = Value.Count + 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 +End Class + +Function NewMalMap(arrKeys, arrValues) + Dim varResult + Set varResult = New MalHashmap + varResult.Init arrKeys, arrValues + Set NewMalMap = varResult +End Function + +Class MalProcedure 'Extends MalType + Public [Type] + Public Value + + Public boolBuiltin + Public boolSpec + Private Sub Class_Initialize + [Type] = TYPES.PROCEDURE + End Sub + + Public Function Init(objFunction, boolIsBuiltin, boolIsSpec) + Set Value = objFunction + boolBuiltin = boolIsBuiltin + boolSpec = boolIsSpec + End Function + + Public Function Apply(objArgs, objEnv) + Dim varResult + If boolBuiltin Then + If boolSpec Then + Set varResult = Value(objArgs, objEnv) + Else + Set varResult = Value(EvaluateRest(objArgs, objEnv)) + End If + Else + wsh.echo "impl later" + End If + Set Apply = varResult + End Function +End Class + +Function NewVbsProc(strFnName, boolSpec) + Dim varResult + Set varResult = New MalProcedure + varResult.Init GetRef(strFnName), True, boolSpec + Set NewVbsProc = varResult +End Function + +Sub CheckArgNum(objArgs, lngExpect) + If objArgs.Value.Count - 1 <> lngExpect Then + boolError = True + strError = "wrong number of arguments" + Call REPL() + End If +End Sub \ No newline at end of file From 9213908533d35547e4d388d5c157b5b6add30cca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 19 Jan 2023 19:36:39 +0800 Subject: [PATCH 023/129] vbs: Rewrite step2 --- impls/vbs/step2_eval.vbs | 177 +++++++++++++++++++++++---------------- impls/vbs/types.vbs | 10 +-- 2 files changed, 107 insertions(+), 80 deletions(-) diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs index bc5123ada3..b7ed5f45bc 100644 --- a/impls/vbs/step2_eval.vbs +++ b/impls/vbs/step2_eval.vbs @@ -1,67 +1,95 @@ Option Explicit -Include "Core.vbs" +Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" +Class Enviroment + Private objDict + Private objSelf + + Private Sub Class_Initialize + Set objDict = CreateObject("Scripting.Dictionary") + End Sub + + Public Function Add(objSymbol, objProcedure) + objDict.Add objSymbol.Value, objProcedure + End Function + + Public Property Set Self(objThis) + Set objSelf = objThis + End Property + + Public Function Find(varKey) + Set Find = objSelf + End Function + + Public Function [Get](objSymbol) + If objDict.Exists(objSymbol.Value) Then + Set [Get] = objDict.Item(objSymbol.Value) + Else + Err.Raise vbObjectError, _ + "Enviroment", "Symbol '" + PrintMalType(objSymbol, True) + "' not found." + End If + End Function +End Class + Dim objEnv -Set objEnv = CreateObject("Scripting.Dictionary") -objEnv.Add "+", GetRef("Add") -objEnv.Add "-", GetRef("Subtract") -objEnv.Add "*", GetRef("Multiply") -objEnv.Add "/", GetRef("Divide") - -Sub CheckArgNum(objArgs, lngExpect) - If objArgs.Value.Count - 1 <> lngExpect Then - boolError = True - strError = "wrong number of arguments" - Call REPL() - End If -End Sub +Set objEnv = New Enviroment +Set objEnv.Self = objEnv 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 + Set Add = NewMalNum( _ + objArgs.Item(1).Value + objArgs.Item(2).Value) End Function +objEnv.Add NewMalSym("+"), NewVbsProc("Add", False) -Function Subtract(objArgs) +Function [Sub](objArgs) CheckArgNum objArgs, 2 - Set Subtract = New MalType - Subtract.Type = TYPE_NUMBER - Subtract.Value = objArgs.Value.Item(1).Value - objArgs.Value.Item(2).Value + Set [Sub] = NewMalNum( _ + objArgs.Item(1).Value - objArgs.Item(2).Value) End Function +objEnv.Add NewMalSym("-"), NewVbsProc("Sub", False) -Function Multiply(objArgs) +Function Mul(objArgs) CheckArgNum objArgs, 2 - Set Multiply = New MalType - Multiply.Type = TYPE_NUMBER - Multiply.Value = objArgs.Value.Item(1).Value * objArgs.Value.Item(2).Value + Set Mul = NewMalNum( _ + objArgs.Item(1).Value * objArgs.Item(2).Value) End Function +objEnv.Add NewMalSym("*"), NewVbsProc("Mul", False) -Function Divide(objArgs) +Function Div(objArgs) CheckArgNum objArgs, 2 - Set Divide = New MalType - Divide.Type = TYPE_NUMBER - Divide.Value = objArgs.Value.Item(1).Value \ objArgs.Value.Item(2).Value + Set Div = NewMalNum( _ + objArgs.Item(1).Value \ objArgs.Item(2).Value) End Function +objEnv.Add NewMalSym("/"), NewVbsProc("Div", False) +Sub CheckArgNum(objArgs, lngArgNum) + If objArgs.Count - 1 <> lngArgNum Then + Err.Raise vbObjectError, _ + "CheckArgNum", "Wrong number of arguments." + 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 + strCode = WScript.StdIn.ReadLine() + If Err.Number <> 0 Then WScript.Quit 0 + On Error Goto 0 + + On Error Resume Next + WScript.Echo REP(strCode) + If Err.Number <> 0 Then + WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + End If On Error Goto 0 - WScript.Echo REP(strCode) Wend End Sub @@ -69,57 +97,64 @@ Function Read(strCode) Set Read = ReadString(strCode) End Function -Function Evaluate(objCode, objEnv) +Function Evaluate(objCode, objEnv) ' Return Nothing / objCode If TypeName(objCode) = "Nothing" Then - Call REPL() + Set Evaluate = Nothing + Exit Function End If - - If objCode.Type = TYPE_LIST Then - If objCode.Value.Count = 0 Then + Dim varRet + If objCode.Type = TYPES.LIST Then + If objCode.Count = 0 Then ' () Set Evaluate = objCode Exit Function End If - - Set Evaluate = EvaluateAST(objCode, objEnv) - Set Evaluate = Evaluate.Value.Item(0)(Evaluate) + Set objCode.Item(0) = Evaluate(objCode.Item(0), objEnv) + Set varRet = objCode.Item(0).Apply(objCode, objEnv) Else - Set Evaluate = EvaluateAST(objCode, objEnv) + Set varRet = EvaluateAST(objCode, objEnv) End If + + Set Evaluate = varRet End Function + Function EvaluateAST(objCode, objEnv) - Dim objResult, i + Dim varRet, i Select Case objCode.Type - Case TYPE_SYMBOL - If objEnv.Exists(objCode.Value) Then - Set objResult = objEnv(objCode.Value) - Else - boolError = True - strError = "symbol not found" - Call REPL() - End If - Case TYPE_LIST - For i = 0 To objCode.Value.Count - 1 - Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) + Case TYPES.SYMBOL + Set varRet = objEnv.Get(objCode) + Case TYPES.LIST + Err.Raise vbObjectError, _ + "EvaluateAST", "Unexpect type." + Case TYPES.VECTOR + For i = 0 To objCode.Count() - 1 + Set objCode.Item(i) = Evaluate(objCode.Item(i)) Next - Set objResult = objCode - Case TYPE_VECTOR - For i = 0 To objCode.Value.Count - 1 - Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) + Set varRet = objCode + Case TYPES.HASHMAP + For Each i In objCode.Keys() + Set objCode.Item(i) = Evaluate(objCode.Item(i)) Next - Set objResult = objCode - Case TYPE_HASHMAP - Dim arrKeys - arrKeys = objCode.Value.Keys - For i = 0 To objCode.Value.Count - 1 - Set objCode.Value.Item(arrKeys(i)) = _ - Evaluate(objCode.Value.Item(arrKeys(i)), objEnv) + Set varRet = objCode + 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 + For i = 1 To objCode.Count() - 1 + Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) Next - Set objResult = objCode + Set varRet = objCode Case Else - Set objResult = objCode + Err.Raise vbObjectError, _ + "EvaluateRest", "Unexpected type." End Select - Set EvaluateAST = objResult + Set EvaluateRest = varRet End Function Function Print(objCode) diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs index 929db9f7ef..90c7d2f3ca 100644 --- a/impls/vbs/types.vbs +++ b/impls/vbs/types.vbs @@ -238,12 +238,4 @@ Function NewVbsProc(strFnName, boolSpec) Set varResult = New MalProcedure varResult.Init GetRef(strFnName), True, boolSpec Set NewVbsProc = varResult -End Function - -Sub CheckArgNum(objArgs, lngExpect) - If objArgs.Value.Count - 1 <> lngExpect Then - boolError = True - strError = "wrong number of arguments" - Call REPL() - End If -End Sub \ No newline at end of file +End Function \ No newline at end of file From 3d2bb5d801226d44814609982e4acf803e64a333 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 19 Jan 2023 21:11:11 +0800 Subject: [PATCH 024/129] vbs: rewrite step3 & fix bugs --- impls/vbs/env.vbs | 128 +++++++----- impls/vbs/step2_eval.vbs | 4 +- impls/vbs/step3_env.vbs | 418 +++++++++++++++++++++++++-------------- 3 files changed, 350 insertions(+), 200 deletions(-) diff --git a/impls/vbs/env.vbs b/impls/vbs/env.vbs index a3f5099d47..94e3485702 100644 --- a/impls/vbs/env.vbs +++ b/impls/vbs/env.vbs @@ -1,73 +1,93 @@ +Option Explicit -class Environment - Private objOuterEnv - Public objBindings - Private objSelf +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 objBindings = CreateObject("Scripting.Dictionary") - Set objOuterEnv = Nothing + Set objBinds = CreateObject("Scripting.Dictionary") + Set objOuter = Nothing Set objSelf = Nothing End Sub - Public Sub Init(objBinds, objExpressions) - 'MsgBox objExpressions.type - Dim i,flag - flag = False - 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 Function SetOuter(objEnv) - Set objOuterEnv = objEnv - End Function - - Public Function SetSelf(objEnv) + Public Property Set Outer(objEnv) + Set objOuter = objEnv + End Property + + Public Property Set Self(objEnv) Set objSelf = objEnv - End Function + 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) - 'objBindings.Add varKey, varValue - Set objBindings(varKey) = varValue + Set objBinds.Item(varKey.Value) = varValue End Sub Public Function Find(varKey) - If objBindings.Exists(varKey) Then - Set Find = objSelf + Dim varRet + If objBinds.Exists(varKey.Value) Then + Set varRet = objSelf Else - If TypeName(objOuterEnv) <> "Nothing" Then - Set Find = objOuterEnv.Find(varKey) + If TypeName(objOuter) <> "Nothing" Then + Set varRet = objOuter.Find(varKey) Else - boolError = True - strError = "symbol " & varKey & " not found" - Call REPL() + Err.Raise vbObjectError, _ + "Environment", "Symbol '" + varKey.Value + "' not found." End If End If + + Set Find = varRet End Function Public Function [Get](varKey) - Set [Get] = Find(varKey).objBindings(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 \ No newline at end of file +End Class \ No newline at end of file diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs index b7ed5f45bc..ad5c16bcaf 100644 --- a/impls/vbs/step2_eval.vbs +++ b/impls/vbs/step2_eval.vbs @@ -128,12 +128,12 @@ Function EvaluateAST(objCode, objEnv) "EvaluateAST", "Unexpect type." Case TYPES.VECTOR For i = 0 To objCode.Count() - 1 - Set objCode.Item(i) = Evaluate(objCode.Item(i)) + Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) Next Set varRet = objCode Case TYPES.HASHMAP For Each i In objCode.Keys() - Set objCode.Item(i) = Evaluate(objCode.Item(i)) + Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) Next Set varRet = objCode Case Else diff --git a/impls/vbs/step3_env.vbs b/impls/vbs/step3_env.vbs index 2a5d0b23e5..1d876bfd84 100644 --- a/impls/vbs/step3_env.vbs +++ b/impls/vbs/step3_env.vbs @@ -1,71 +1,113 @@ Option Explicit -Include "Core.vbs" +Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" Include "Env.vbs" Dim objEnv -Set objEnv = New Environment -objEnv.SetSelf objEnv -objEnv.SetOuter Nothing -objEnv.Add "+", GetRef("Add") -objEnv.Add "-", GetRef("Subtract") -objEnv.Add "*", GetRef("Multiply") -objEnv.Add "/", GetRef("Divide") - - -Sub CheckArgNum(objArgs, lngExpect) - If objArgs.Value.Count - 1 <> lngExpect Then - boolError = True - strError = "wrong number of arguments" - Call REPL() - End If -End Sub +Set objEnv = NewEnv(Nothing) + +Function MAdd(objArgs) + CheckArgNum objArgs, 2 + Set MAdd = NewMalNum( _ + objArgs.Item(1).Value + objArgs.Item(2).Value) +End Function +objEnv.Add NewMalSym("+"), NewVbsProc("MAdd", False) -Function Add(objArgs) +Function MSub(objArgs) CheckArgNum objArgs, 2 - Set Add = New MalType - Add.Type = TYPE_NUMBER - Add.Value = objArgs.Value.Item(1).Value + objArgs.Value.Item(2).Value + Set MSub = NewMalNum( _ + objArgs.Item(1).Value - objArgs.Item(2).Value) End Function +objEnv.Add NewMalSym("-"), NewVbsProc("MSub", False) -Function Subtract(objArgs) +Function MMul(objArgs) CheckArgNum objArgs, 2 - Set Subtract = New MalType - Subtract.Type = TYPE_NUMBER - Subtract.Value = objArgs.Value.Item(1).Value - objArgs.Value.Item(2).Value + Set MMul = NewMalNum( _ + objArgs.Item(1).Value * objArgs.Item(2).Value) End Function +objEnv.Add NewMalSym("*"), NewVbsProc("MMul", False) -Function Multiply(objArgs) +Function MDiv(objArgs) CheckArgNum objArgs, 2 - Set Multiply = New MalType - Multiply.Type = TYPE_NUMBER - Multiply.Value = objArgs.Value.Item(1).Value * objArgs.Value.Item(2).Value + 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 -Function Divide(objArgs) +Function MDef(objArgs, objEnv) + Dim varRet CheckArgNum objArgs, 2 - Set Divide = New MalType - Divide.Type = TYPE_NUMBER - Divide.Value = objArgs.Value.Item(1).Value \ objArgs.Value.Item(2).Value + CheckType objArgs.Item(1), TYPES.SYMBOL + Set varRet = Evaluate(objArgs.Item(2), objEnv) + objEnv.Add objArgs.Item(1), varRet + Set MDef = varRet End Function +objEnv.Add NewMalSym("def!"), NewVbsProc("MDef", True) + +Function MLet(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + 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 + + 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 = Evaluate(objArgs.Item(2), objNewEnv) + Set MLet = varRet +End Function +objEnv.Add NewMalSym("let*"), NewVbsProc("MLet", True) 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 + strCode = WScript.StdIn.ReadLine() + If Err.Number <> 0 Then WScript.Quit 0 + On Error Goto 0 + + 'On Error Resume Next + WScript.Echo REP(strCode) + If Err.Number <> 0 Then + WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + End If On Error Goto 0 - WScript.Echo REP(strCode) Wend End Sub @@ -73,126 +115,64 @@ Function Read(strCode) Set Read = ReadString(strCode) End Function -Function Evaluate(objCode, objEnv) - Dim i +Function Evaluate(objCode, objEnv) ' Return Nothing / objCode If TypeName(objCode) = "Nothing" Then - Call REPL() + Set Evaluate = Nothing + Exit Function End If - - If objCode.Type = TYPE_LIST Then - If objCode.Value.Count = 0 Then + Dim varRet + If objCode.Type = TYPES.LIST Then + If objCode.Count = 0 Then ' () Set Evaluate = objCode Exit Function End If - - Dim objSymbol - Set objSymbol = Evaluate(objCode.Value.Item(0), objEnv) - If TypeName(objSymbol) = "MalType" Then - 'MsgBox TypeName(objCode.value) - Select Case objSymbol.Value - Case "def!" - CheckArgNum objCode, 2 - CheckSymbol objCode.Value.Item(1) - 'MsgBox 2 - objEnv.Add objCode.Value.Item(1).Value, _ - Evaluate(objCode.Value.Item(2), objEnv) - 'MsgBox 3 - 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) - End Select - Else - Set Evaluate = objSymbol(EvaluateAST(objCode, objEnv)) - End If + Set objCode.Item(0) = Evaluate(objCode.Item(0), objEnv) + Set varRet = objCode.Item(0).Apply(objCode, objEnv) Else - Set Evaluate = EvaluateAST(objCode, objEnv) + Set varRet = EvaluateAST(objCode, objEnv) End If -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 + Set Evaluate = varRet +End Function -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 + Dim varRet, i Select Case objCode.Type - Case TYPE_SYMBOL - Select Case objCode.Value - Case "def!" - Set objResult = objCode - Case "let*" - Set objResult = objCode - Case Else - Set objResult = objEnv.Get(objCode.Value) - End Select - Case TYPE_LIST - For i = 0 To objCode.Value.Count - 1 - Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) + Case TYPES.SYMBOL + Set varRet = objEnv.Get(objCode) + Case TYPES.LIST + Err.Raise vbObjectError, _ + "EvaluateAST", "Unexpect type." + Case TYPES.VECTOR + For i = 0 To objCode.Count() - 1 + Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) Next - Set objResult = objCode - Case TYPE_VECTOR - For i = 0 To objCode.Value.Count - 1 - Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) + Set varRet = objCode + Case TYPES.HASHMAP + For Each i In objCode.Keys() + Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) Next - Set objResult = objCode - Case TYPE_HASHMAP - Dim arrKeys - arrKeys = objCode.Value.Keys - For i = 0 To objCode.Value.Count - 1 - Set objCode.Value.Item(arrKeys(i)) = _ - Evaluate(objCode.Value.Item(arrKeys(i)), objEnv) + Set varRet = objCode + 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 + For i = 1 To objCode.Count() - 1 + Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) Next - Set objResult = objCode + Set varRet = objCode Case Else - Set objResult = objCode + Err.Raise vbObjectError, _ + "EvaluateRest", "Unexpected type." End Select - Set EvaluateAST = objResult + Set EvaluateRest = varRet End Function Function Print(objCode) @@ -210,4 +190,154 @@ Sub Include(strFileName) .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With -End Sub \ No newline at end of file +End Sub + + + + + + + + +' Function Read(strCode) +' Set Read = ReadString(strCode) +' End Function + +' Function Evaluate(objCode, objEnv) +' 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 +' Set objSymbol = Evaluate(objCode.Value.Item(0), objEnv) +' If TypeName(objSymbol) = "MalType" Then +' 'MsgBox TypeName(objCode.value) +' Select Case objSymbol.Value +' Case "def!" +' CheckArgNum objCode, 2 +' CheckSymbol objCode.Value.Item(1) +' 'MsgBox 2 +' objEnv.Add objCode.Value.Item(1).Value, _ +' Evaluate(objCode.Value.Item(2), objEnv) +' 'MsgBox 3 +' 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) +' End Select +' Else +' Set Evaluate = objSymbol(EvaluateAST(objCode, objEnv)) +' End If +' Else +' Set Evaluate = EvaluateAST(objCode, objEnv) +' End If +' 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 +' Select Case objCode.Value +' Case "def!" +' Set objResult = objCode +' Case "let*" +' Set objResult = objCode +' Case Else +' Set objResult = objEnv.Get(objCode.Value) +' End Select +' Case TYPE_LIST +' For i = 0 To objCode.Value.Count - 1 +' Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) +' Next +' Set objResult = objCode +' Case TYPE_VECTOR +' For i = 0 To objCode.Value.Count - 1 +' Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) +' Next +' Set objResult = objCode +' Case TYPE_HASHMAP +' Dim arrKeys +' arrKeys = objCode.Value.Keys +' For i = 0 To objCode.Value.Count - 1 +' Set objCode.Value.Item(arrKeys(i)) = _ +' Evaluate(objCode.Value.Item(arrKeys(i)), objEnv) +' Next +' Set objResult = objCode +' 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), objEnv)) +' End Function + +' Sub Include(strFileName) +' With CreateObject("Scripting.FileSystemObject") +' ExecuteGlobal .OpenTextFile( _ +' .GetParentFolderName( _ +' .GetFile(WScript.ScriptFullName)) & _ +' "\" & strFileName).ReadAll +' End With +' End Sub \ No newline at end of file From 1466dd84d6e404155fe0d237e08f6fc1f4ee4188 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Thu, 19 Jan 2023 23:05:05 +0800 Subject: [PATCH 025/129] vbs: rewrite step4 1 --- impls/vbs/printer.vbs | 2 - impls/vbs/step2_eval.vbs | 15 + impls/vbs/step3_env.vbs | 160 +------ impls/vbs/step4_if_fn_do.vbs | 832 +++++++++++++++++++++++------------ impls/vbs/types.vbs | 83 +++- 5 files changed, 633 insertions(+), 459 deletions(-) diff --git a/impls/vbs/printer.vbs b/impls/vbs/printer.vbs index 84b13c7ff9..a01fa97c70 100644 --- a/impls/vbs/printer.vbs +++ b/impls/vbs/printer.vbs @@ -68,8 +68,6 @@ Function PrintMalType(objMal, boolReadable) varResult = "nil" Case TYPES.NUMBER varResult = CStr(objMal.Value) - Case TYPES.LAMBDA - varResult = "#" Case TYPES.PROCEDURE varResult = "#" Case TYPES.KEYWORD diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs index ad5c16bcaf..7dace04fdb 100644 --- a/impls/vbs/step2_eval.vbs +++ b/impls/vbs/step2_eval.vbs @@ -40,6 +40,8 @@ Set objEnv.Self = objEnv Function Add(objArgs) CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER Set Add = NewMalNum( _ objArgs.Item(1).Value + objArgs.Item(2).Value) End Function @@ -47,6 +49,8 @@ objEnv.Add NewMalSym("+"), NewVbsProc("Add", False) Function [Sub](objArgs) CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER Set [Sub] = NewMalNum( _ objArgs.Item(1).Value - objArgs.Item(2).Value) End Function @@ -54,6 +58,8 @@ objEnv.Add NewMalSym("-"), NewVbsProc("Sub", False) Function Mul(objArgs) CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER Set Mul = NewMalNum( _ objArgs.Item(1).Value * objArgs.Item(2).Value) End Function @@ -61,6 +67,8 @@ objEnv.Add NewMalSym("*"), NewVbsProc("Mul", False) Function Div(objArgs) CheckArgNum objArgs, 2 + CheckType objArgs.Item(1), TYPES.NUMBER + CheckType objArgs.Item(2), TYPES.NUMBER Set Div = NewMalNum( _ objArgs.Item(1).Value \ objArgs.Item(2).Value) End Function @@ -73,6 +81,13 @@ Sub CheckArgNum(objArgs, lngArgNum) End IF End Sub +Sub CheckType(objMal, varType) + If objMal.Type <> varType Then + Err.Raise vbObjectError, _ + "CheckType", "Wrong argument type." + End IF +End Sub + Call REPL() Sub REPL() Dim strCode, strResult diff --git a/impls/vbs/step3_env.vbs b/impls/vbs/step3_env.vbs index 1d876bfd84..8e7f0dc702 100644 --- a/impls/vbs/step3_env.vbs +++ b/impls/vbs/step3_env.vbs @@ -10,6 +10,8 @@ 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 @@ -17,6 +19,8 @@ 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 @@ -24,6 +28,8 @@ 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 @@ -31,6 +37,8 @@ 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 @@ -190,154 +198,4 @@ Sub Include(strFileName) .GetFile(WScript.ScriptFullName)) & _ "\" & strFileName).ReadAll End With -End Sub - - - - - - - - -' Function Read(strCode) -' Set Read = ReadString(strCode) -' End Function - -' Function Evaluate(objCode, objEnv) -' 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 -' Set objSymbol = Evaluate(objCode.Value.Item(0), objEnv) -' If TypeName(objSymbol) = "MalType" Then -' 'MsgBox TypeName(objCode.value) -' Select Case objSymbol.Value -' Case "def!" -' CheckArgNum objCode, 2 -' CheckSymbol objCode.Value.Item(1) -' 'MsgBox 2 -' objEnv.Add objCode.Value.Item(1).Value, _ -' Evaluate(objCode.Value.Item(2), objEnv) -' 'MsgBox 3 -' 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) -' End Select -' Else -' Set Evaluate = objSymbol(EvaluateAST(objCode, objEnv)) -' End If -' Else -' Set Evaluate = EvaluateAST(objCode, objEnv) -' End If -' 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 -' Select Case objCode.Value -' Case "def!" -' Set objResult = objCode -' Case "let*" -' Set objResult = objCode -' Case Else -' Set objResult = objEnv.Get(objCode.Value) -' End Select -' Case TYPE_LIST -' For i = 0 To objCode.Value.Count - 1 -' Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) -' Next -' Set objResult = objCode -' Case TYPE_VECTOR -' For i = 0 To objCode.Value.Count - 1 -' Set objCode.Value.Item(i) = Evaluate(objCode.Value.Item(i), objEnv) -' Next -' Set objResult = objCode -' Case TYPE_HASHMAP -' Dim arrKeys -' arrKeys = objCode.Value.Keys -' For i = 0 To objCode.Value.Count - 1 -' Set objCode.Value.Item(arrKeys(i)) = _ -' Evaluate(objCode.Value.Item(arrKeys(i)), objEnv) -' Next -' Set objResult = objCode -' 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), objEnv)) -' End Function - -' Sub Include(strFileName) -' With CreateObject("Scripting.FileSystemObject") -' ExecuteGlobal .OpenTextFile( _ -' .GetParentFolderName( _ -' .GetFile(WScript.ScriptFullName)) & _ -' "\" & strFileName).ReadAll -' End With -' End Sub \ No newline at end of file +End Sub \ No newline at end of file diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs index 0fc5a1c771..fad64cb2f3 100644 --- a/impls/vbs/step4_if_fn_do.vbs +++ b/impls/vbs/step4_if_fn_do.vbs @@ -1,76 +1,173 @@ -'TODO ×Ö·û´®ÓÐÎÊÌâ - Option Explicit -Dim DEPTH -DEPTH = 0 -Dim CALLFROM -CALLFROM = "" -Include "Core.vbs" + +Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" Include "Env.vbs" -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 +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 NewSpecialForm(strValue) - Set NewSpecialForm = New MalType - NewSpecialForm.Value = strValue - NewSpecialForm.Type = TYPE_SPECIAL +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 IsSpecialForm(objForm) - IsSpecialForm = (objForm.Type = TYPE_SPECIAL) +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) -Class SpecialForm - Public Value -End Class +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, lngExpect) - If objArgs.Value.Count - 1 <> lngExpect Then - boolError = True - strError = "wrong number of arguments" - Call REPL() - End If +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 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 +objEnv.Add NewMalSym("def!"), NewVbsProc("MDef", True) + +Function MLet(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + 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 + + 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 = Evaluate(objArgs.Item(2), objNewEnv) + Set MLet = varRet +End Function +objEnv.Add NewMalSym("let*"), NewVbsProc("MLet", True) + +Function MDo(objArgs, objEnv) + Dim varRet, i + For i = 1 To objArgs.Count - 1 + Set varRet = Evaluate(objArgs.Item(i), objEnv) + Next + Set MDo = varRet +End Function +objEnv.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 + + If Evaluate(objArgs.Item(1), objEnv).Value Then + Set varRet = Evaluate(objArgs.Item(2), objEnv) + Else + If objArgs.Count - 1 = 3 Then + Set varRet = Evaluate(objArgs.Item(3), objEnv) + Else + Set varRet = NewMalNil() + End If + End If + Set MIf = varRet +End Function +objEnv.Add NewMalSym("if"), NewVbsProc("MIf", True) + +Function MFn(objArgs, objEnv) + Dim varRet + CheckArgNum objArgs, 2 + + Dim objParams, objCode + Set objParams = objArgs.Item(1) + 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 + Next + Set varRet = NewMalProc(objParams, objCode, objEnv) + Set MFn = varRet +End Function +objEnv.Add NewMalSym("fn*"), NewVbsProc("MFn", True) + 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 + strCode = WScript.StdIn.ReadLine() + If Err.Number <> 0 Then WScript.Quit 0 + On Error Goto 0 + + 'On Error Resume Next + WScript.Echo REP(strCode) + If Err.Number <> 0 Then + WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + End If On Error Goto 0 - WScript.Echo REP(strCode) Wend End Sub @@ -78,262 +175,64 @@ Function Read(strCode) Set Read = ReadString(strCode) End Function - -Function Evaluate(objCode, objEnv) - DEPTH = DEPTH + 1 - Dim i +Function Evaluate(objCode, objEnv) ' Return Nothing / objCode If TypeName(objCode) = "Nothing" Then - Call REPL() + Set Evaluate = Nothing + Exit Function End If - - If objCode.Type = TYPE_LIST Then - If objCode.Value.Count = 0 Then + Dim varRet + If objCode.Type = TYPES.LIST Then + If objCode.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 "ÎÒÔÚ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) - - 'ÕâÀïÓдóÎÊÌâ - 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 + Set objCode.Item(0) = Evaluate(objCode.Item(0), objEnv) + Set varRet = objCode.Item(0).Apply(objCode, objEnv) 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 "" + Set varRet = EvaluateAST(objCode, objEnv) 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 + Set Evaluate = varRet 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 + Dim varRet, 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) + Case TYPES.SYMBOL + Set varRet = objEnv.Get(objCode) + Case TYPES.LIST + Err.Raise vbObjectError, _ + "EvaluateAST", "Unexpect type." + Case TYPES.VECTOR + For i = 0 To objCode.Count() - 1 + Set objCode.Item(i) = Evaluate(objCode.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) + Set varRet = objCode + Case TYPES.HASHMAP + For Each i In objCode.Keys() + Set objCode.Item(i) = Evaluate(objCode.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) + Set varRet = objCode + 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 + For i = 1 To objCode.Count() - 1 + Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) Next + Set varRet = objCode Case Else - Set objResult = objCode + Err.Raise vbObjectError, _ + "EvaluateRest", "Unexpected type." End Select - Set EvaluateAST = objResult + Set EvaluateRest = varRet End Function Function Print(objCode) @@ -341,7 +240,7 @@ Function Print(objCode) End Function Function REP(strCode) - REP = Print(Evaluate(Read(strCode), objRootEnv)) + REP = Print(Evaluate(Read(strCode), objEnv)) End Function Sub Include(strFileName) @@ -352,3 +251,354 @@ Sub Include(strFileName) "\" & 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 "����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) + +' '��������� +' 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 diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs index 90c7d2f3ca..53b87c9b05 100644 --- a/impls/vbs/types.vbs +++ b/impls/vbs/types.vbs @@ -6,14 +6,14 @@ Set TYPES = New MalTypes Class MalTypes Public LIST, VECTOR, HASHMAP, [BOOLEAN], NIL Public KEYWORD, [STRING], NUMBER, SYMBOL - Public LAMBDA, PROCEDURE + Public PROCEDURE Public [TypeName] Private Sub Class_Initialize [TypeName] = Array( _ "LIST", "VECTOR", "HASHMAP", "BOOLEAN", _ "NIL", "KEYWORD", "STRING", "NUMBER", _ - "SYMBOL", "LAMBDA", "PROCEDURE") + "SYMBOL", "PROCEDURE") Dim i For i = 0 To UBound([TypeName]) @@ -202,32 +202,26 @@ Function NewMalMap(arrKeys, arrValues) Set NewMalMap = varResult End Function -Class MalProcedure 'Extends MalType +Class VbsProcedure 'Extends MalType Public [Type] Public Value - Public boolBuiltin Public boolSpec Private Sub Class_Initialize [Type] = TYPES.PROCEDURE End Sub - Public Function Init(objFunction, boolIsBuiltin, boolIsSpec) + Public Function Init(objFunction, boolIsSpec) Set Value = objFunction - boolBuiltin = boolIsBuiltin boolSpec = boolIsSpec End Function Public Function Apply(objArgs, objEnv) Dim varResult - If boolBuiltin Then - If boolSpec Then - Set varResult = Value(objArgs, objEnv) - Else - Set varResult = Value(EvaluateRest(objArgs, objEnv)) - End If + If boolSpec Then + Set varResult = Value(objArgs, objEnv) Else - wsh.echo "impl later" + Set varResult = Value(EvaluateRest(objArgs, objEnv)) End If Set Apply = varResult End Function @@ -235,7 +229,66 @@ End Class Function NewVbsProc(strFnName, boolSpec) Dim varResult - Set varResult = New MalProcedure - varResult.Init GetRef(strFnName), True, boolSpec + Set varResult = New VbsProcedure + varResult.Init GetRef(strFnName), boolSpec Set NewVbsProc = varResult +End Function + +Class MalProcedure 'Extends MalType + Public [Type] + Public Value + + Private Sub Class_Initialize + [Type] = TYPES.PROCEDURE + End Sub + + Private 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) + 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, _ + "MalProcedure", "Invalid parameter(s)." + End If + Else + If i + 1 >= objArgs.Count Then + Err.Raise vbObjectError, _ + "MalProcedure", "Need more arguments." + End If + objNewEnv.Add objParams.Item(i), _ + Evaluate(objArgs.Item(i + 1), objEnv) + i = i + 1 + End If + Wend + Set varRet = Evaluate(objCode, objNewEnv) + Set Apply = varRet + 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 \ No newline at end of file From d8698416ab1b23be54c2a40b8cffde38cc865fed Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Thu, 19 Jan 2023 23:56:35 +0800 Subject: [PATCH 026/129] vbs: add some functions --- impls/vbs/core.vbs | 413 ++++++++++++---------------------- impls/vbs/env.vbs | 34 --- impls/vbs/step4_if_fn_do.vbs | 420 +---------------------------------- impls/vbs/types.vbs | 1 + 4 files changed, 144 insertions(+), 724 deletions(-) diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index 15512e2d36..cf9e92ce39 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -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 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 - -' Function mFirst(objArgs) -' 'Set objRes = New MalType -' Set objRes = objArgs.value.item(1).value.item(0) -' Set mFirst= objRes -' 'msgbox 1 -' End Function - -' 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 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 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 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 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 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 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 - -' 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 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 - - -' 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 - - -' 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 - -' Sub Er(sInfo) -' boolError = True -' strError = sInfo -' End Sub - -' 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 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 -' 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 +Dim objNS +Set objNS = 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 +objNS.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 +objNS.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 +objNS.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 +objNS.Add NewMalSym("/"), NewVbsProc("MDiv", False) + +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 MIsList(objArgs) + CheckArgNum objArgs, 1 + + Set MIsList = NewMalBool(objArgs.Item(1).Type = TYPES.LIST) +End Function +objNS.Add NewMalSym("list?"), NewVbsProc("MIsList", False) + +Function MIsEmpty(objArgs) + 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) + CheckArgNum objArgs, 1 + CheckListOrVec objArgs.Item(1) + + Set MCount = NewMalNum(objArgs.Item(1).Count) +End Function +objNS.Add NewMalSym("count"), NewVbsProc("MCount", False) + +Function MEqual(objArgs) + 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)))).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 + + Set MEqual = varRet +End Function +objNS.Add NewMalSym("="), NewVbsProc("MEqual", False) + +'Todo > < >= <= pr-str str prn println \ No newline at end of file diff --git a/impls/vbs/env.vbs b/impls/vbs/env.vbs index 94e3485702..b350a13174 100644 --- a/impls/vbs/env.vbs +++ b/impls/vbs/env.vbs @@ -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 diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs index fad64cb2f3..5b3551fb72 100644 --- a/impls/vbs/step4_if_fn_do.vbs +++ b/impls/vbs/step4_if_fn_do.vbs @@ -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 "����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) - -' '��������� -' 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 \ No newline at end of file diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs index 53b87c9b05..ef8727e91f 100644 --- a/impls/vbs/types.vbs +++ b/impls/vbs/types.vbs @@ -281,6 +281,7 @@ Class MalProcedure 'Extends MalType i = i + 1 End If Wend + Set varRet = Evaluate(objCode, objNewEnv) Set Apply = varRet End Function From 7e842012e85f6481f94e7b1ecf70b39212912ada Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Fri, 20 Jan 2023 19:15:11 +0800 Subject: [PATCH 027/129] vbs: fix evaluater's bug (create instead modify a list) --- impls/vbs/core.vbs | 101 +++++++++++++++++++++++++- impls/vbs/step2_eval.vbs | 21 +++--- impls/vbs/step3_env.vbs | 23 +++--- impls/vbs/step4_if_fn_do.vbs | 113 ++++------------------------- impls/vbs/tests/step4_if_fn_do.mal | 6 ++ impls/vbs/types.vbs | 2 +- 6 files changed, 143 insertions(+), 123 deletions(-) create mode 100644 impls/vbs/tests/step4_if_fn_do.mal diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index cf9e92ce39..810a5bdf82 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -31,6 +31,91 @@ End Sub Dim objNS Set objNS = NewEnv(Nothing) +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 = Evaluate(objArgs.Item(2), objNewEnv) + Set MLet = varRet +End Function +objNS.Add NewMalSym("let*"), NewVbsProc("MLet", True) + +Function MDo(objArgs, objEnv) + Dim varRet, i + For i = 1 To objArgs.Count - 1 + Set varRet = Evaluate(objArgs.Item(i), objEnv) + Next + 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 + + If Evaluate(objArgs.Item(1), objEnv).Value Then + Set varRet = Evaluate(objArgs.Item(2), objEnv) + Else + If objArgs.Count - 1 = 3 Then + Set varRet = Evaluate(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 MAdd(objArgs) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER @@ -139,4 +224,18 @@ Function MEqual(objArgs) End Function objNS.Add NewMalSym("="), NewVbsProc("MEqual", False) -'Todo > < >= <= pr-str str prn println \ No newline at end of file +Function MGreater(objArgs) + 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) + +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))))" \ No newline at end of file diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs index 7dace04fdb..8212001380 100644 --- a/impls/vbs/step2_eval.vbs +++ b/impls/vbs/step2_eval.vbs @@ -112,19 +112,19 @@ Function Read(strCode) Set Read = ReadString(strCode) End Function -Function Evaluate(objCode, objEnv) ' Return Nothing / objCode +Function Evaluate(objCode, objEnv) If TypeName(objCode) = "Nothing" Then Set Evaluate = Nothing Exit Function End If - Dim varRet + Dim varRet, objFirst If objCode.Type = TYPES.LIST Then If objCode.Count = 0 Then ' () Set Evaluate = objCode Exit Function End If - Set objCode.Item(0) = Evaluate(objCode.Item(0), objEnv) - Set varRet = objCode.Item(0).Apply(objCode, objEnv) + Set objFirst = Evaluate(objCode.Item(0), objEnv) + Set varRet = objFirst.Apply(objCode, objEnv) Else Set varRet = EvaluateAST(objCode, objEnv) End If @@ -142,15 +142,16 @@ Function EvaluateAST(objCode, objEnv) Err.Raise vbObjectError, _ "EvaluateAST", "Unexpect type." Case TYPES.VECTOR + Set varRet = NewMalVec(Array()) For i = 0 To objCode.Count() - 1 - Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) + varRet.Add Evaluate(objCode.Item(i), objEnv) Next - Set varRet = objCode Case TYPES.HASHMAP + Set varRet = NewMalMap(Array(), Array()) For Each i In objCode.Keys() - Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) + varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next - Set varRet = objCode + 'Case Atom Case Else Set varRet = objCode End Select @@ -161,10 +162,10 @@ 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 - Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) + varRet.Add Evaluate(objCode.Item(i), objEnv) Next - Set varRet = objCode Case Else Err.Raise vbObjectError, _ "EvaluateRest", "Unexpected type." diff --git a/impls/vbs/step3_env.vbs b/impls/vbs/step3_env.vbs index 8e7f0dc702..fd27a94d51 100644 --- a/impls/vbs/step3_env.vbs +++ b/impls/vbs/step3_env.vbs @@ -110,7 +110,7 @@ Sub REPL() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 - 'On Error Resume Next + On Error Resume Next WScript.Echo REP(strCode) If Err.Number <> 0 Then WScript.StdErr.WriteLine Err.Source + ": " + Err.Description @@ -123,19 +123,19 @@ Function Read(strCode) Set Read = ReadString(strCode) End Function -Function Evaluate(objCode, objEnv) ' Return Nothing / objCode +Function Evaluate(objCode, objEnv) If TypeName(objCode) = "Nothing" Then Set Evaluate = Nothing Exit Function End If - Dim varRet + Dim varRet, objFirst If objCode.Type = TYPES.LIST Then If objCode.Count = 0 Then ' () Set Evaluate = objCode Exit Function End If - Set objCode.Item(0) = Evaluate(objCode.Item(0), objEnv) - Set varRet = objCode.Item(0).Apply(objCode, objEnv) + Set objFirst = Evaluate(objCode.Item(0), objEnv) + Set varRet = objFirst.Apply(objCode, objEnv) Else Set varRet = EvaluateAST(objCode, objEnv) End If @@ -153,15 +153,16 @@ Function EvaluateAST(objCode, objEnv) Err.Raise vbObjectError, _ "EvaluateAST", "Unexpect type." Case TYPES.VECTOR + Set varRet = NewMalVec(Array()) For i = 0 To objCode.Count() - 1 - Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) + varRet.Add Evaluate(objCode.Item(i), objEnv) Next - Set varRet = objCode Case TYPES.HASHMAP + Set varRet = NewMalMap(Array(), Array()) For Each i In objCode.Keys() - Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) + varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next - Set varRet = objCode + 'Case Atom Case Else Set varRet = objCode End Select @@ -172,10 +173,10 @@ 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 - Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) + varRet.Add Evaluate(objCode.Item(i), objEnv) Next - Set varRet = objCode Case Else Err.Raise vbObjectError, _ "EvaluateRest", "Unexpected type." diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs index 5b3551fb72..d28a1f709c 100644 --- a/impls/vbs/step4_if_fn_do.vbs +++ b/impls/vbs/step4_if_fn_do.vbs @@ -6,94 +6,6 @@ Include "Printer.vbs" Include "Env.vbs" Include "Core.vbs" -Dim objEnv -Set objEnv = objNS - -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 -objEnv.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 = Evaluate(objArgs.Item(2), objNewEnv) - Set MLet = varRet -End Function -objEnv.Add NewMalSym("let*"), NewVbsProc("MLet", True) - -Function MDo(objArgs, objEnv) - Dim varRet, i - For i = 1 To objArgs.Count - 1 - Set varRet = Evaluate(objArgs.Item(i), objEnv) - Next - Set MDo = varRet -End Function -objEnv.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 - - If Evaluate(objArgs.Item(1), objEnv).Value Then - Set varRet = Evaluate(objArgs.Item(2), objEnv) - Else - If objArgs.Count - 1 = 3 Then - Set varRet = Evaluate(objArgs.Item(3), objEnv) - Else - Set varRet = NewMalNil() - End If - End If - Set MIf = varRet -End Function -objEnv.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 -objEnv.Add NewMalSym("fn*"), NewVbsProc("MFn", True) - Call REPL() Sub REPL() Dim strCode, strResult @@ -105,7 +17,7 @@ Sub REPL() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 - 'On Error Resume Next + On Error Resume Next WScript.Echo REP(strCode) If Err.Number <> 0 Then WScript.StdErr.WriteLine Err.Source + ": " + Err.Description @@ -118,19 +30,19 @@ Function Read(strCode) Set Read = ReadString(strCode) End Function -Function Evaluate(objCode, objEnv) ' Return Nothing / objCode +Function Evaluate(objCode, objEnv) If TypeName(objCode) = "Nothing" Then Set Evaluate = Nothing Exit Function End If - Dim varRet + Dim varRet, objFirst If objCode.Type = TYPES.LIST Then If objCode.Count = 0 Then ' () Set Evaluate = objCode Exit Function End If - Set objCode.Item(0) = Evaluate(objCode.Item(0), objEnv) - Set varRet = objCode.Item(0).Apply(objCode, objEnv) + Set objFirst = Evaluate(objCode.Item(0), objEnv) + Set varRet = objFirst.Apply(objCode, objEnv) Else Set varRet = EvaluateAST(objCode, objEnv) End If @@ -148,15 +60,16 @@ Function EvaluateAST(objCode, objEnv) Err.Raise vbObjectError, _ "EvaluateAST", "Unexpect type." Case TYPES.VECTOR + Set varRet = NewMalVec(Array()) For i = 0 To objCode.Count() - 1 - Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) + varRet.Add Evaluate(objCode.Item(i), objEnv) Next - Set varRet = objCode Case TYPES.HASHMAP + Set varRet = NewMalMap(Array(), Array()) For Each i In objCode.Keys() - Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) + varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next - Set varRet = objCode + 'Case Atom Case Else Set varRet = objCode End Select @@ -167,10 +80,10 @@ 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 - Set objCode.Item(i) = Evaluate(objCode.Item(i), objEnv) + varRet.Add Evaluate(objCode.Item(i), objEnv) Next - Set varRet = objCode Case Else Err.Raise vbObjectError, _ "EvaluateRest", "Unexpected type." @@ -183,7 +96,7 @@ Function Print(objCode) End Function Function REP(strCode) - REP = Print(Evaluate(Read(strCode), objEnv)) + REP = Print(Evaluate(Read(strCode), objNS)) End Function Sub Include(strFileName) diff --git a/impls/vbs/tests/step4_if_fn_do.mal b/impls/vbs/tests/step4_if_fn_do.mal new file mode 100644 index 0000000000..b5a0ea3c1a --- /dev/null +++ b/impls/vbs/tests/step4_if_fn_do.mal @@ -0,0 +1,6 @@ +(def! f (fn* [x] (list x))) +(f 0) +(f 1) + +((fn* [x] x) (list)) +((fn* [x] [x]) (list)) \ No newline at end of file diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs index ef8727e91f..c08a87b49d 100644 --- a/impls/vbs/types.vbs +++ b/impls/vbs/types.vbs @@ -282,7 +282,7 @@ Class MalProcedure 'Extends MalType End If Wend - Set varRet = Evaluate(objCode, objNewEnv) + Set varRet = Evaluate(objCode, objNewEnv) 'todo: make a objcode copy Set Apply = varRet End Function End Class From beddcf563986aa47237d1c4deb72a926ceb68886 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Fri, 20 Jan 2023 21:36:46 +0800 Subject: [PATCH 028/129] vbs: add prn println str prn-str --- impls/vbs/core.vbs | 81 ++++++++++++++++++++++++++++++++++++++++++--- impls/vbs/types.vbs | 2 +- 2 files changed, 77 insertions(+), 6 deletions(-) diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index 810a5bdf82..54ee74d954 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -85,7 +85,16 @@ Function MIf(objArgs, objEnv) "MIf", "Wrong number of arguments." End If - If Evaluate(objArgs.Item(1), objEnv).Value Then + 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 = Evaluate(objArgs.Item(2), objEnv) Else If objArgs.Count - 1 = 3 Then @@ -180,9 +189,12 @@ objNS.Add NewMalSym("empty?"), NewVbsProc("MIsEmpty", False) Function MCount(objArgs) CheckArgNum objArgs, 1 - CheckListOrVec objArgs.Item(1) - - Set MCount = NewMalNum(objArgs.Item(1).Count) + 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) @@ -238,4 +250,63 @@ objNS.Add NewMalSym(">"), NewVbsProc("MGreater", False) 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))))" \ No newline at end of file +REP "(def! >= (fn* [a b] (not (> b a))))" + +Function MPrStr(objArgs) + 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) + 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) + Dim varRet + Dim objStr + Set objStr = MPrStr(objArgs) + WScript.StdOut.WriteLine objStr.Value + Set varRet = NewMalNil() + Set MPrn = varRet +End Function +objNS.Add NewMalSym("prn"), NewVbsProc("MPrn", False) + +Function MPrintln(objArgs) + 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) diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs index c08a87b49d..2b4d039b1d 100644 --- a/impls/vbs/types.vbs +++ b/impls/vbs/types.vbs @@ -47,7 +47,7 @@ Function NewMalBool(varValue) End Function Function NewMalNil() - Set NewMalNil = NewMalType(TYPES.NIL, Null) + Set NewMalNil = NewMalType(TYPES.NIL, Empty) End Function Function NewMalKwd(varValue) From e8e0ac64a9f9bfa90fd4325bc83a5b9c6cb11dc4 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Fri, 20 Jan 2023 21:50:12 +0800 Subject: [PATCH 029/129] vbs: move specials from core to step4 --- impls/vbs/core.vbs | 106 +++-------------------------------- impls/vbs/step4_if_fn_do.vbs | 100 +++++++++++++++++++++++++++++++++ 2 files changed, 107 insertions(+), 99 deletions(-) diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index 54ee74d954..9183520144 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -31,100 +31,6 @@ End Sub Dim objNS Set objNS = NewEnv(Nothing) -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 = Evaluate(objArgs.Item(2), objNewEnv) - Set MLet = varRet -End Function -objNS.Add NewMalSym("let*"), NewVbsProc("MLet", True) - -Function MDo(objArgs, objEnv) - Dim varRet, i - For i = 1 To objArgs.Count - 1 - Set varRet = Evaluate(objArgs.Item(i), objEnv) - Next - 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 = Evaluate(objArgs.Item(2), objEnv) - Else - If objArgs.Count - 1 = 3 Then - Set varRet = Evaluate(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 MAdd(objArgs) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER @@ -247,11 +153,6 @@ Function MGreater(objArgs) End Function objNS.Add NewMalSym(">"), NewVbsProc("MGreater", False) -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))))" - Function MPrStr(objArgs) Dim varRet Dim strRet @@ -310,3 +211,10 @@ Function MPrintln(objArgs) 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))))" +End Sub \ No newline at end of file diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs index d28a1f709c..e9cb6dd22b 100644 --- a/impls/vbs/step4_if_fn_do.vbs +++ b/impls/vbs/step4_if_fn_do.vbs @@ -6,6 +6,106 @@ Include "Printer.vbs" Include "Env.vbs" Include "Core.vbs" +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 = Evaluate(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 - 1 + Set varRet = Evaluate(objArgs.Item(i), objEnv) + Next + 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 = Evaluate(objArgs.Item(2), objEnv) + Else + If objArgs.Count - 1 = 3 Then + Set varRet = Evaluate(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) + +Call InitBuiltIn() + Call REPL() Sub REPL() Dim strCode, strResult From 48dfd2fc400c921036c97b9b0aee78b7c1bdc659 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sat, 21 Jan 2023 00:09:26 +0800 Subject: [PATCH 030/129] vbs: fix ByRef's bug, todo: fix mem leak --- impls/vbs/env.vbs | 4 + impls/vbs/step4_if_fn_do.vbs | 7 + impls/vbs/step5_tco.vbs | 236 +++++++++++++++++++++++++++++ impls/vbs/tests/step4_if_fn_do.mal | 6 - impls/vbs/types.vbs | 3 +- 5 files changed, 248 insertions(+), 8 deletions(-) create mode 100644 impls/vbs/step5_tco.vbs delete mode 100644 impls/vbs/tests/step4_if_fn_do.mal diff --git a/impls/vbs/env.vbs b/impls/vbs/env.vbs index b350a13174..8bddd93919 100644 --- a/impls/vbs/env.vbs +++ b/impls/vbs/env.vbs @@ -21,6 +21,10 @@ Class Environment Set objOuter = objEnv End Property + Public Property Get Outer() + Set Outer = objOuter + End Property + Public Property Set Self(objEnv) Set objSelf = objEnv End Property diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs index e9cb6dd22b..30b832a48e 100644 --- a/impls/vbs/step4_if_fn_do.vbs +++ b/impls/vbs/step4_if_fn_do.vbs @@ -6,6 +6,13 @@ Include "Printer.vbs" Include "Env.vbs" Include "Core.vbs" +Function EvalLater(objMal, objEnv) + ' A fake implement, for compatibility. + Dim varRes + Set varRes = Evaluate(objMal, objEnv) + Set EvalLater = varRes +End Function + Function MDef(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 diff --git a/impls/vbs/step5_tco.vbs b/impls/vbs/step5_tco.vbs new file mode 100644 index 0000000000..25208a13be --- /dev/null +++ b/impls/vbs/step5_tco.vbs @@ -0,0 +1,236 @@ +Option Explicit + +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" +Include "Core.vbs" + +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) + +Call InitBuiltIn() + +Call REPL() +Sub REPL() + Dim strCode, strResult + 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 + + On Error Resume Next + WScript.Echo REP(strCode) + If Err.Number <> 0 Then + WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + 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 + 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 Atom + 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 \ No newline at end of file diff --git a/impls/vbs/tests/step4_if_fn_do.mal b/impls/vbs/tests/step4_if_fn_do.mal deleted file mode 100644 index b5a0ea3c1a..0000000000 --- a/impls/vbs/tests/step4_if_fn_do.mal +++ /dev/null @@ -1,6 +0,0 @@ -(def! f (fn* [x] (list x))) -(f 0) -(f 1) - -((fn* [x] x) (list)) -((fn* [x] [x]) (list)) \ No newline at end of file diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs index 2b4d039b1d..6b24264db4 100644 --- a/impls/vbs/types.vbs +++ b/impls/vbs/types.vbs @@ -251,7 +251,6 @@ Class MalProcedure 'Extends MalType Public Function Apply(objArgs, objEnv) Dim varRet - Dim objNewEnv Set objNewEnv = NewEnv(objSavedEnv) Dim i @@ -282,7 +281,7 @@ Class MalProcedure 'Extends MalType End If Wend - Set varRet = Evaluate(objCode, objNewEnv) 'todo: make a objcode copy + Set varRet = EvalLater(objCode, objNewEnv) Set Apply = varRet End Function End Class From edd1e2751069b9f8a39507f4421199b9f1c12e5c Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sun, 22 Jan 2023 22:41:56 +0800 Subject: [PATCH 031/129] vbs: step6 finish! --- impls/vbs/core.vbs | 99 ++++++++++++++- impls/vbs/printer.vbs | 4 +- impls/vbs/step5_tco.vbs | 1 + impls/vbs/step6_file.vbs | 264 +++++++++++++++++++++++++++++++++++++++ impls/vbs/types.vbs | 27 +++- 5 files changed, 388 insertions(+), 7 deletions(-) create mode 100644 impls/vbs/step6_file.vbs diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index 9183520144..da1367225c 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -217,4 +217,101 @@ Sub InitBuiltIn() REP "(def! <= (fn* [a b] (not (> a b))))" REP "(def! < (fn* [a b] (> b a)))" REP "(def! >= (fn* [a b] (not (> b a))))" -End Sub \ No newline at end of file + REP "(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))" +End Sub + +Function MReadStr(objArgs) + Dim varRes + CheckArgNum objArgs, 1 + CheckType objArgs.Item(1), TYPES.STRING + + Set varRes = ReadString(objArgs.Item(1).Value) + Set MReadStr = varRes +End Function +objNS.Add NewMalSym("read-string"), NewVbsProc("MReadStr", False) + +Function MSlurp(objArgs) + 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) + 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) + 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) + 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) + 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 + Set objAtom = Evaluate(objArgs.Item(1), objEnv) + CheckType objAtom, TYPES.ATOM + + Dim objFn + Set objFn = Evaluate(objArgs.Item(2), objEnv) + CheckType objFn, TYPES.PROCEDURE + + Dim objProc + Set objProc = NewMalList(Array(objFn)) + objProc.Add objAtom.Value + Dim i + For i = 3 To objArgs.Count - 1 + objProc.Add Evaluate(objArgs.Item(i), objEnv) + Next + + objAtom.Reset Evaluate(objProc, objEnv) + Set varRes = objAtom.Value + Set MSwap = varRes +End Function +objNS.Add NewMalSym("swap!"), NewVbsProc("MSwap", True) diff --git a/impls/vbs/printer.vbs b/impls/vbs/printer.vbs index a01fa97c70..fd78defe27 100644 --- a/impls/vbs/printer.vbs +++ b/impls/vbs/printer.vbs @@ -74,9 +74,11 @@ Function PrintMalType(objMal, boolReadable) 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" + "PrintMalType", "Unknown type." End Select PrintMalType = varResult diff --git a/impls/vbs/step5_tco.vbs b/impls/vbs/step5_tco.vbs index 25208a13be..50001f5b6f 100644 --- a/impls/vbs/step5_tco.vbs +++ b/impls/vbs/step5_tco.vbs @@ -152,6 +152,7 @@ Function Evaluate(ByVal objCode, ByVal objEnv) Set Evaluate = Nothing Exit Function End If + Dim varRet, objFirst If objCode.Type = TYPES.LIST Then If objCode.Count = 0 Then ' () diff --git a/impls/vbs/step6_file.vbs b/impls/vbs/step6_file.vbs new file mode 100644 index 0000000000..95c3356ee0 --- /dev/null +++ b/impls/vbs/step6_file.vbs @@ -0,0 +1,264 @@ +Option Explicit + +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" +Include "Core.vbs" + +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) + +Call InitBuiltIn() + +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) + """)" + wsh.echo 1111 + End If +End Sub + +Call REPL() +Sub REPL() + Dim strCode, strResult + 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 + + On Error Resume Next + WScript.Echo REP(strCode) + If Err.Number <> 0 Then + WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + 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 + + 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 \ No newline at end of file diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs index 6b24264db4..4bd8198dc1 100644 --- a/impls/vbs/types.vbs +++ b/impls/vbs/types.vbs @@ -6,14 +6,14 @@ Set TYPES = New MalTypes Class MalTypes Public LIST, VECTOR, HASHMAP, [BOOLEAN], NIL Public KEYWORD, [STRING], NUMBER, SYMBOL - Public PROCEDURE + Public PROCEDURE, ATOM Public [TypeName] Private Sub Class_Initialize [TypeName] = Array( _ "LIST", "VECTOR", "HASHMAP", "BOOLEAN", _ "NIL", "KEYWORD", "STRING", "NUMBER", _ - "SYMBOL", "PROCEDURE") + "SYMBOL", "PROCEDURE", "ATOM") Dim i For i = 0 To UBound([TypeName]) @@ -30,9 +30,6 @@ Class MalType [Type] = lngType Value = varValue End Function - - Public Function Copy() - End Function End Class Function NewMalType(lngType, varValue) @@ -66,6 +63,26 @@ Function NewMalSym(varValue) Set NewMalSym = NewMalType(TYPES.SYMBOL, varValue) End Function +Class MalAtom + Public [Type] + Public Value + + 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 From 44010effdc62bbb2ef8b5c4ee1055225836a3c9d Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sun, 22 Jan 2023 22:59:42 +0800 Subject: [PATCH 032/129] vbs: rewrite all: normal fun will recive Env also --- impls/vbs/core.vbs | 62 +++++++++++++++++++--------------------- impls/vbs/step2_eval.vbs | 24 ++++++++-------- impls/vbs/step3_env.vbs | 8 +++--- impls/vbs/step6_file.vbs | 1 - impls/vbs/types.vbs | 2 +- 5 files changed, 47 insertions(+), 50 deletions(-) diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index da1367225c..98a133ce36 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -31,7 +31,7 @@ End Sub Dim objNS Set objNS = NewEnv(Nothing) -Function MAdd(objArgs) +Function MAdd(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER @@ -40,7 +40,7 @@ Function MAdd(objArgs) End Function objNS.Add NewMalSym("+"), NewVbsProc("MAdd", False) -Function MSub(objArgs) +Function MSub(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER @@ -49,7 +49,7 @@ Function MSub(objArgs) End Function objNS.Add NewMalSym("-"), NewVbsProc("MSub", False) -Function MMul(objArgs) +Function MMul(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER @@ -58,7 +58,7 @@ Function MMul(objArgs) End Function objNS.Add NewMalSym("*"), NewVbsProc("MMul", False) -Function MDiv(objArgs) +Function MDiv(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER @@ -67,7 +67,7 @@ Function MDiv(objArgs) End Function objNS.Add NewMalSym("/"), NewVbsProc("MDiv", False) -Function MList(objArgs) +Function MList(objArgs, objEnv) Dim varRet Set varRet = NewMalList(Array()) Dim i @@ -78,14 +78,14 @@ Function MList(objArgs) End Function objNS.Add NewMalSym("list"), NewVbsProc("MList", False) -Function MIsList(objArgs) +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) +Function MIsEmpty(objArgs, objEnv) CheckArgNum objArgs, 1 CheckListOrVec objArgs.Item(1) @@ -93,7 +93,7 @@ Function MIsEmpty(objArgs) End Function objNS.Add NewMalSym("empty?"), NewVbsProc("MIsEmpty", False) -Function MCount(objArgs) +Function MCount(objArgs, objEnv) CheckArgNum objArgs, 1 If objArgs.Item(1).Type = TYPES.NIL Then Set MCount = NewMalNum(0) @@ -104,7 +104,7 @@ Function MCount(objArgs) End Function objNS.Add NewMalSym("count"), NewVbsProc("MCount", False) -Function MEqual(objArgs) +Function MEqual(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 @@ -142,7 +142,7 @@ Function MEqual(objArgs) End Function objNS.Add NewMalSym("="), NewVbsProc("MEqual", False) -Function MGreater(objArgs) +Function MGreater(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER @@ -153,7 +153,7 @@ Function MGreater(objArgs) End Function objNS.Add NewMalSym(">"), NewVbsProc("MGreater", False) -Function MPrStr(objArgs) +Function MPrStr(objArgs, objEnv) Dim varRet Dim strRet strRet = "" @@ -170,7 +170,7 @@ Function MPrStr(objArgs) End Function objNS.Add NewMalSym("pr-str"), NewVbsProc("MPrStr", False) -Function MStr(objArgs) +Function MStr(objArgs, objEnv) Dim varRet Dim strRet strRet = "" @@ -184,17 +184,17 @@ Function MStr(objArgs) End Function objNS.Add NewMalSym("str"), NewVbsProc("MStr", False) -Function MPrn(objArgs) +Function MPrn(objArgs, objEnv) Dim varRet Dim objStr - Set objStr = MPrStr(objArgs) + 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) +Function MPrintln(objArgs, objEnv) Dim varRet Dim strRes strRes = "" @@ -220,7 +220,7 @@ Sub InitBuiltIn() REP "(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))" End Sub -Function MReadStr(objArgs) +Function MReadStr(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 CheckType objArgs.Item(1), TYPES.STRING @@ -230,7 +230,7 @@ Function MReadStr(objArgs) End Function objNS.Add NewMalSym("read-string"), NewVbsProc("MReadStr", False) -Function MSlurp(objArgs) +Function MSlurp(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 CheckType objArgs.Item(1), TYPES.STRING @@ -248,7 +248,7 @@ Function MSlurp(objArgs) End Function objNS.Add NewMalSym("slurp"), NewVbsProc("MSlurp", False) -Function MAtom(objArgs) +Function MAtom(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 @@ -257,7 +257,7 @@ Function MAtom(objArgs) End Function objNS.Add NewMalSym("atom"), NewVbsProc("MAtom", False) -Function MIsAtom(objArgs) +Function MIsAtom(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 @@ -266,7 +266,7 @@ Function MIsAtom(objArgs) End Function objNS.Add NewMalSym("atom?"), NewVbsProc("MIsAtom", False) -Function MDeref(objArgs) +Function MDeref(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 CheckType objArgs.Item(1), TYPES.ATOM @@ -276,7 +276,7 @@ Function MDeref(objArgs) End Function objNS.Add NewMalSym("deref"), NewVbsProc("MDeref", False) -Function MReset(objArgs) +Function MReset(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.ATOM @@ -294,24 +294,22 @@ Function MSwap(objArgs, objEnv) "MSwap", "Need more arguments." End If - Dim objAtom - Set objAtom = Evaluate(objArgs.Item(1), objEnv) + Dim objAtom, objFn + Set objAtom = objArgs.Item(1) CheckType objAtom, TYPES.ATOM - - Dim objFn - Set objFn = Evaluate(objArgs.Item(2), objEnv) + Set objFn = objArgs.Item(2) CheckType objFn, TYPES.PROCEDURE - Dim objProc - Set objProc = NewMalList(Array(objFn)) - objProc.Add objAtom.Value + Dim objProg + Set objProg = NewMalList(Array(objFn)) + objProg.Add objAtom.Value Dim i For i = 3 To objArgs.Count - 1 - objProc.Add Evaluate(objArgs.Item(i), objEnv) + objProg.Add objArgs.Item(i) Next - objAtom.Reset Evaluate(objProc, objEnv) + objAtom.Reset Evaluate(objProg, objEnv) Set varRes = objAtom.Value Set MSwap = varRes End Function -objNS.Add NewMalSym("swap!"), NewVbsProc("MSwap", True) +objNS.Add NewMalSym("swap!"), NewVbsProc("MSwap", False) diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs index 8212001380..3506b8eec6 100644 --- a/impls/vbs/step2_eval.vbs +++ b/impls/vbs/step2_eval.vbs @@ -38,41 +38,41 @@ Dim objEnv Set objEnv = New Enviroment Set objEnv.Self = objEnv -Function Add(objArgs) +Function MAdd(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER - Set Add = NewMalNum( _ + Set MAdd = NewMalNum( _ objArgs.Item(1).Value + objArgs.Item(2).Value) End Function -objEnv.Add NewMalSym("+"), NewVbsProc("Add", False) +objEnv.Add NewMalSym("+"), NewVbsProc("MAdd", False) -Function [Sub](objArgs) +Function MSub(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER - Set [Sub] = NewMalNum( _ + Set MSub = NewMalNum( _ objArgs.Item(1).Value - objArgs.Item(2).Value) End Function -objEnv.Add NewMalSym("-"), NewVbsProc("Sub", False) +objEnv.Add NewMalSym("-"), NewVbsProc("MSub", False) -Function Mul(objArgs) +Function MMul(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER - Set Mul = NewMalNum( _ + Set MMul = NewMalNum( _ objArgs.Item(1).Value * objArgs.Item(2).Value) End Function -objEnv.Add NewMalSym("*"), NewVbsProc("Mul", False) +objEnv.Add NewMalSym("*"), NewVbsProc("MMul", False) -Function Div(objArgs) +Function MDiv(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER - Set Div = NewMalNum( _ + Set MDiv = NewMalNum( _ objArgs.Item(1).Value \ objArgs.Item(2).Value) End Function -objEnv.Add NewMalSym("/"), NewVbsProc("Div", False) +objEnv.Add NewMalSym("/"), NewVbsProc("MDiv", False) Sub CheckArgNum(objArgs, lngArgNum) If objArgs.Count - 1 <> lngArgNum Then diff --git a/impls/vbs/step3_env.vbs b/impls/vbs/step3_env.vbs index fd27a94d51..294046d6e8 100644 --- a/impls/vbs/step3_env.vbs +++ b/impls/vbs/step3_env.vbs @@ -8,7 +8,7 @@ Include "Env.vbs" Dim objEnv Set objEnv = NewEnv(Nothing) -Function MAdd(objArgs) +Function MAdd(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER @@ -17,7 +17,7 @@ Function MAdd(objArgs) End Function objEnv.Add NewMalSym("+"), NewVbsProc("MAdd", False) -Function MSub(objArgs) +Function MSub(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER @@ -26,7 +26,7 @@ Function MSub(objArgs) End Function objEnv.Add NewMalSym("-"), NewVbsProc("MSub", False) -Function MMul(objArgs) +Function MMul(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER @@ -35,7 +35,7 @@ Function MMul(objArgs) End Function objEnv.Add NewMalSym("*"), NewVbsProc("MMul", False) -Function MDiv(objArgs) +Function MDiv(objArgs, objEnv) CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.NUMBER CheckType objArgs.Item(2), TYPES.NUMBER diff --git a/impls/vbs/step6_file.vbs b/impls/vbs/step6_file.vbs index 95c3356ee0..2fb698ad2a 100644 --- a/impls/vbs/step6_file.vbs +++ b/impls/vbs/step6_file.vbs @@ -146,7 +146,6 @@ Sub InitArgs() If WScript.Arguments.Count > 0 Then REP "(load-file """ + WScript.Arguments.Item(0) + """)" - wsh.echo 1111 End If End Sub diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs index 4bd8198dc1..1b010027ab 100644 --- a/impls/vbs/types.vbs +++ b/impls/vbs/types.vbs @@ -238,7 +238,7 @@ Class VbsProcedure 'Extends MalType If boolSpec Then Set varResult = Value(objArgs, objEnv) Else - Set varResult = Value(EvaluateRest(objArgs, objEnv)) + Set varResult = Value(EvaluateRest(objArgs, objEnv), objEnv) End If Set Apply = varResult End Function From 1c9d8bc4268bdd07c887ece62fb76938e5addc00 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Tue, 24 Jan 2023 00:32:39 +0800 Subject: [PATCH 033/129] vbs: step 7 finish a half --- impls/vbs/core.vbs | 32 ++++ impls/vbs/install.vbs | 3 +- impls/vbs/step0_repl.vbs | 2 +- impls/vbs/step1_read_print.vbs | 2 +- impls/vbs/step2_eval.vbs | 3 +- impls/vbs/step3_env.vbs | 3 +- impls/vbs/step4_if_fn_do.vbs | 3 +- impls/vbs/step5_tco.vbs | 3 +- impls/vbs/step6_file.vbs | 2 +- impls/vbs/step7_quote.vbs | 328 +++++++++++++++++++++++++++++++++ 10 files changed, 368 insertions(+), 13 deletions(-) create mode 100644 impls/vbs/step7_quote.vbs diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index 98a133ce36..41123713a9 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -218,6 +218,7 @@ Sub InitBuiltIn() 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)))" End Sub Function MReadStr(objArgs, objEnv) @@ -313,3 +314,34 @@ Function MSwap(objArgs, objEnv) 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) diff --git a/impls/vbs/install.vbs b/impls/vbs/install.vbs index a66409b0c1..ca97f52901 100644 --- a/impls/vbs/install.vbs +++ b/impls/vbs/install.vbs @@ -1,3 +1,2 @@ On Error Resume Next -With CreateObject("System.Collections.ArrayList") -End With \ No newline at end of file +CreateObject("System.Collections.ArrayList") \ No newline at end of file diff --git a/impls/vbs/step0_repl.vbs b/impls/vbs/step0_repl.vbs index c965e39539..9c920dab44 100644 --- a/impls/vbs/step0_repl.vbs +++ b/impls/vbs/step0_repl.vbs @@ -18,7 +18,7 @@ End Function Dim strCode While True 'REPL - WScript.StdOut.Write("user> ") + WScript.StdOut.Write "user> " On Error Resume Next strCode = WScript.StdIn.ReadLine() If Err.Number <> 0 Then WScript.Quit 0 diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index 314754787c..ececf82dfb 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -9,7 +9,7 @@ Call REPL() Sub REPL() Dim strCode While True - WScript.StdOut.Write("user> ") + WScript.StdOut.Write "user> " On Error Resume Next strCode = WScript.StdIn.ReadLine() diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs index 3506b8eec6..b132000fe6 100644 --- a/impls/vbs/step2_eval.vbs +++ b/impls/vbs/step2_eval.vbs @@ -92,7 +92,7 @@ Call REPL() Sub REPL() Dim strCode, strResult While True - WScript.StdOut.Write("user> ") + WScript.StdOut.Write "user> " On Error Resume Next strCode = WScript.StdIn.ReadLine() @@ -151,7 +151,6 @@ Function EvaluateAST(objCode, objEnv) For Each i In objCode.Keys() varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next - 'Case Atom Case Else Set varRet = objCode End Select diff --git a/impls/vbs/step3_env.vbs b/impls/vbs/step3_env.vbs index 294046d6e8..bd6d4558dd 100644 --- a/impls/vbs/step3_env.vbs +++ b/impls/vbs/step3_env.vbs @@ -103,7 +103,7 @@ Call REPL() Sub REPL() Dim strCode, strResult While True - WScript.StdOut.Write("user> ") + WScript.StdOut.Write "user> " On Error Resume Next strCode = WScript.StdIn.ReadLine() @@ -162,7 +162,6 @@ Function EvaluateAST(objCode, objEnv) For Each i In objCode.Keys() varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next - 'Case Atom Case Else Set varRet = objCode End Select diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs index 30b832a48e..83e377415e 100644 --- a/impls/vbs/step4_if_fn_do.vbs +++ b/impls/vbs/step4_if_fn_do.vbs @@ -117,7 +117,7 @@ Call REPL() Sub REPL() Dim strCode, strResult While True - WScript.StdOut.Write("user> ") + WScript.StdOut.Write "user> " On Error Resume Next strCode = WScript.StdIn.ReadLine() @@ -176,7 +176,6 @@ Function EvaluateAST(objCode, objEnv) For Each i In objCode.Keys() varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next - 'Case Atom Case Else Set varRet = objCode End Select diff --git a/impls/vbs/step5_tco.vbs b/impls/vbs/step5_tco.vbs index 50001f5b6f..5462aa3d6b 100644 --- a/impls/vbs/step5_tco.vbs +++ b/impls/vbs/step5_tco.vbs @@ -126,7 +126,7 @@ Call REPL() Sub REPL() Dim strCode, strResult While True - WScript.StdOut.Write("user> ") + WScript.StdOut.Write "user> " On Error Resume Next strCode = WScript.StdIn.ReadLine() @@ -197,7 +197,6 @@ Function EvaluateAST(objCode, objEnv) For Each i In objCode.Keys() varRet.Add i, Evaluate(objCode.Item(i), objEnv) Next - 'Case Atom Case Else Set varRet = objCode End Select diff --git a/impls/vbs/step6_file.vbs b/impls/vbs/step6_file.vbs index 2fb698ad2a..4c0e7955a0 100644 --- a/impls/vbs/step6_file.vbs +++ b/impls/vbs/step6_file.vbs @@ -153,7 +153,7 @@ Call REPL() Sub REPL() Dim strCode, strResult While True - WScript.StdOut.Write("user> ") + WScript.StdOut.Write "user> " On Error Resume Next strCode = WScript.StdIn.ReadLine() diff --git a/impls/vbs/step7_quote.vbs b/impls/vbs/step7_quote.vbs new file mode 100644 index 0000000000..bc001a16c3 --- /dev/null +++ b/impls/vbs/step7_quote.vbs @@ -0,0 +1,328 @@ +Option Explicit + +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" +Include "Core.vbs" + +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 = QuasiQuoteHelper(objArgs.Item(1), objEnv).Item(0) + Set MQuasiQuote = varRes +End Function +objNS.Add NewMalSym("quasiquote"), NewVbsProc("MQuasiQuote", True) + +Function QuasiQuoteHelper(objArg, objEnv) + Dim varRes + If IsListOrVec(objArg) Then + Dim i, j + Dim objList + If objArg.Count > 0 Then + If objArg.Item(0).Type = TYPES.SYMBOL Then + Select Case objArg.Item(0).Value + Case "unquote" ' ~x -> (x) + CheckArgNum objArg, 1 + Set varRes = NewMalList(Array( _ + Evaluate(objArg.Item(1), objEnv))) + Case "splice-unquote" ' ~@x -> x + CheckArgNum objArg, 1 + Set varRes = Evaluate(objArg.Item(1), objEnv) + If Not IsListOrVec(varRes) Then + Err.Raise vbObjectError, _ + "QuasiQuoteHelper", "Wrong return value type." + End If + Case Else ' (x y z) -> ((x y z)) + Set varRes = NewMalList(Array()) + varRes.Add NewMalList(Array()) + For i = 0 To objArg.Count - 1 + Set objList = QuasiQuoteHelper(objArg.Item(i), objEnv) + For j = 0 To objList.Count - 1 + varRes.Item(0).Add objList.Item(j) + Next + Next + End Select + Else ' (x y z) -> ((x y z)) + Set varRes = NewMalList(Array()) + varRes.Add NewMalList(Array()) + For i = 0 To objArg.Count - 1 + Set objList = QuasiQuoteHelper(objArg.Item(i), objEnv) + For j = 0 To objList.Count - 1 + varRes.Item(0).Add objList.Item(j) + Next + Next + End If + Else ' () -> (()) + Set varRes = NewMalList(Array( _ + NewMalList(Array()))) + End If + Else ' x -> (x) + Set varRes = NewMalList(Array(objArg)) + End If + + Set QuasiQuoteHelper = varRes +End Function + +Call InitBuiltIn() + +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) + """)" + End If +End Sub + +Call REPL() +Sub REPL() + Dim strCode, strResult + 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 + + 'On Error Resume Next + WScript.Echo REP(strCode) + If Err.Number <> 0 Then + WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + 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 + + 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 \ No newline at end of file From cd055ee54e58899613b749f755bc9661bc4f2bf8 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Thu, 26 Jan 2023 17:10:03 +0800 Subject: [PATCH 034/129] vbs: rewrite quasiquote with quasiquoteexpand & fix vec --- impls/vbs/step7_quote.vbs | 145 +++++++++++++++++++++++++++----------- 1 file changed, 102 insertions(+), 43 deletions(-) diff --git a/impls/vbs/step7_quote.vbs b/impls/vbs/step7_quote.vbs index bc001a16c3..5d3ed5b84e 100644 --- a/impls/vbs/step7_quote.vbs +++ b/impls/vbs/step7_quote.vbs @@ -140,59 +140,118 @@ Function MQuasiQuote(objArgs, objEnv) Dim varRes CheckArgNum objArgs, 1 - Set varRes = QuasiQuoteHelper(objArgs.Item(1), objEnv).Item(0) + Set varRes = EvalLater( _ + MQuasiQuoteExpand(objArgs, objEnv), objEnv) Set MQuasiQuote = varRes End Function objNS.Add NewMalSym("quasiquote"), NewVbsProc("MQuasiQuote", True) -Function QuasiQuoteHelper(objArg, objEnv) +Function MQuasiQuoteExpand(objArgs, objEnv) Dim varRes - If IsListOrVec(objArg) Then - Dim i, j - Dim objList - If objArg.Count > 0 Then - If objArg.Item(0).Type = TYPES.SYMBOL Then - Select Case objArg.Item(0).Value - Case "unquote" ' ~x -> (x) - CheckArgNum objArg, 1 - Set varRes = NewMalList(Array( _ - Evaluate(objArg.Item(1), objEnv))) - Case "splice-unquote" ' ~@x -> x - CheckArgNum objArg, 1 - Set varRes = Evaluate(objArg.Item(1), objEnv) - If Not IsListOrVec(varRes) Then - Err.Raise vbObjectError, _ - "QuasiQuoteHelper", "Wrong return value type." - End If - Case Else ' (x y z) -> ((x y z)) - Set varRes = NewMalList(Array()) - varRes.Add NewMalList(Array()) - For i = 0 To objArg.Count - 1 - Set objList = QuasiQuoteHelper(objArg.Item(i), objEnv) - For j = 0 To objList.Count - 1 - varRes.Item(0).Add objList.Item(j) - Next - Next - End Select - Else ' (x y z) -> ((x y z)) + 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()) - varRes.Add NewMalList(Array()) + Set varBuilder = varRes + For i = 0 To objArg.Count - 1 - Set objList = QuasiQuoteHelper(objArg.Item(i), objEnv) - For j = 0 To objList.Count - 1 - varRes.Item(0).Add objList.Item(j) - Next + 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 - Else ' () -> (()) + Case TYPES.VECTOR Set varRes = NewMalList(Array( _ - NewMalList(Array()))) - End If - Else ' x -> (x) - Set varRes = NewMalList(Array(objArg)) - End If + 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 QuasiQuoteHelper = varRes + Set ExpandHelper = NewExpandType(varRes, boolSplice) End Function Call InitBuiltIn() @@ -225,7 +284,7 @@ Sub REPL() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 - 'On Error Resume Next + On Error Resume Next WScript.Echo REP(strCode) If Err.Number <> 0 Then WScript.StdErr.WriteLine Err.Source + ": " + Err.Description From f647d3b1f931791e9bba336925966dcfab78e43a Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Thu, 26 Jan 2023 18:57:47 +0800 Subject: [PATCH 035/129] vbs: step8 a half finished --- impls/vbs/step8_macros.vbs | 443 +++++++++++++++++++++++++++++++++++++ impls/vbs/types.vbs | 66 +++++- 2 files changed, 507 insertions(+), 2 deletions(-) create mode 100644 impls/vbs/step8_macros.vbs diff --git a/impls/vbs/step8_macros.vbs b/impls/vbs/step8_macros.vbs new file mode 100644 index 0000000000..f24be3a462 --- /dev/null +++ b/impls/vbs/step8_macros.vbs @@ -0,0 +1,443 @@ +Option Explicit + +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" +Include "Core.vbs" + +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) + 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) + +Call InitBuiltIn() + +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) + """)" + End If +End Sub + +Call REPL() +Sub REPL() + Dim strCode, strResult + 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 + + 'On Error Resume Next + WScript.Echo REP(strCode) + If Err.Number <> 0 Then + WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + 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 \ No newline at end of file diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs index 1b010027ab..2653afbb2e 100644 --- a/impls/vbs/types.vbs +++ b/impls/vbs/types.vbs @@ -223,11 +223,17 @@ Class VbsProcedure 'Extends MalType Public [Type] Public Value + Public IsMacro Public boolSpec Private Sub Class_Initialize [Type] = TYPES.PROCEDURE + IsMacro = False End Sub + Public Property Get IsSpecial() + IsSpecial = boolSpec + End Property + Public Function Init(objFunction, boolIsSpec) Set Value = objFunction boolSpec = boolIsSpec @@ -255,8 +261,15 @@ Class MalProcedure 'Extends MalType Public [Type] Public Value + Public IsMacro + + Public Property Get IsSpecial() + IsSpecial = False + End Property + Private Sub Class_Initialize [Type] = TYPES.PROCEDURE + IsMacro = False End Sub Private objParams, objCode, objSavedEnv @@ -285,12 +298,12 @@ Class MalProcedure 'Extends MalType i = objParams.Count ' Break While Else Err.Raise vbObjectError, _ - "MalProcedure", "Invalid parameter(s)." + "MalProcedureApply", "Invalid parameter(s)." End If Else If i + 1 >= objArgs.Count Then Err.Raise vbObjectError, _ - "MalProcedure", "Need more arguments." + "MalProcedureApply", "Need more arguments." End If objNewEnv.Add objParams.Item(i), _ Evaluate(objArgs.Item(i + 1), objEnv) @@ -301,6 +314,47 @@ Class MalProcedure 'Extends MalType 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()) + 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 + objNewEnv.Add objParams.Item(i), _ + objArgs.Item(i + 1) + i = i + 1 + End If + Wend + + Set varRet = Evaluate(objCode, objNewEnv) + Set MacroApply = varRet + End Function End Class Function NewMalProc(objParams, objCode, objEnv) @@ -308,4 +362,12 @@ Function NewMalProc(objParams, objCode, objEnv) 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 \ No newline at end of file From cc65a063c9e6c5f0254c87dab1b6189ce3f64134 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Thu, 26 Jan 2023 19:49:30 +0800 Subject: [PATCH 036/129] vbs: step8 finish! --- impls/vbs/core.vbs | 64 ++++++++++++++++++++++++++++++++++++++ impls/vbs/step8_macros.vbs | 8 ++++- impls/vbs/types.vbs | 5 +++ 3 files changed, 76 insertions(+), 1 deletion(-) diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index 41123713a9..c8b31d2a8d 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -345,3 +345,67 @@ Function MVec(objArgs, objEnv) 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 bound." + 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 = NewMalNil() + 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) + diff --git a/impls/vbs/step8_macros.vbs b/impls/vbs/step8_macros.vbs index f24be3a462..c14231c65d 100644 --- a/impls/vbs/step8_macros.vbs +++ b/impls/vbs/step8_macros.vbs @@ -308,6 +308,12 @@ End Function objNS.Add NewMalSym("macroexpand"), NewVbsProc("MMacroExpand", True) Call InitBuiltIn() +Call InitMacro() + +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))))))))" +End Sub Call InitArgs() Sub InitArgs() @@ -337,7 +343,7 @@ Sub REPL() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 - 'On Error Resume Next + On Error Resume Next WScript.Echo REP(strCode) If Err.Number <> 0 Then WScript.StdErr.WriteLine Err.Source + ": " + Err.Description diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs index 2653afbb2e..e4a04a5a77 100644 --- a/impls/vbs/types.vbs +++ b/impls/vbs/types.vbs @@ -331,6 +331,8 @@ Class MalProcedure 'Extends MalType 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) @@ -346,12 +348,15 @@ Class MalProcedure 'Extends MalType 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 From d8d2237ab8fad291ea867356a9398ff2c9c4c68d Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Thu, 26 Jan 2023 21:51:50 +0800 Subject: [PATCH 037/129] vbs: step9 finished a quarter --- impls/vbs/core.vbs | 36 +++ impls/vbs/step8_macros.vbs | 5 - impls/vbs/step9_try.vbs | 493 +++++++++++++++++++++++++++++++++++++ impls/vbs/types.vbs | 5 + 4 files changed, 534 insertions(+), 5 deletions(-) create mode 100644 impls/vbs/step9_try.vbs diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index c8b31d2a8d..d9fec768b2 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -409,3 +409,39 @@ Function MRest(objArgs, objEnv) 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))))))))" +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) \ No newline at end of file diff --git a/impls/vbs/step8_macros.vbs b/impls/vbs/step8_macros.vbs index c14231c65d..94e98d0edc 100644 --- a/impls/vbs/step8_macros.vbs +++ b/impls/vbs/step8_macros.vbs @@ -310,11 +310,6 @@ objNS.Add NewMalSym("macroexpand"), NewVbsProc("MMacroExpand", True) Call InitBuiltIn() Call InitMacro() -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))))))))" -End Sub - Call InitArgs() Sub InitArgs() Dim objArgs diff --git a/impls/vbs/step9_try.vbs b/impls/vbs/step9_try.vbs new file mode 100644 index 0000000000..136f3c96a7 --- /dev/null +++ b/impls/vbs/step9_try.vbs @@ -0,0 +1,493 @@ +Option Explicit + +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" +Include "Core.vbs" + +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) + 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 + + 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() + + Set varRes = Evaluate(NewMalList(Array( _ + NewMalSym("let*"), NewMalList(Array( _ + objCatch.Item(1), objException)), _ + objCatch.Item(2))), objEnv) + End If + On Error Goto 0 + + 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) + """)" + End If +End Sub + +Call REPL() +Sub REPL() + Dim strCode, strResult + 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 + + On Error Resume Next + WScript.Echo REP(strCode) + If Err.Number <> 0 Then + If Err.Source = "MThrow" Then + WScript.StdErr.WriteLine Err.Source + ": " + _ + PrintMalType(objExceptions.Item(Err.Description), True) + objExceptions.Remove Err.Description + Else + WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + 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 \ No newline at end of file diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs index e4a04a5a77..b0cc09bc06 100644 --- a/impls/vbs/types.vbs +++ b/impls/vbs/types.vbs @@ -280,6 +280,11 @@ Class MalProcedure 'Extends MalType 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) From f9eb0e16ae44984600f1f1eb41db0c59045713a0 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Fri, 27 Jan 2023 13:45:58 +0800 Subject: [PATCH 038/129] vbs: step9 finish except hashmap --- impls/vbs/core.vbs | 132 +++++++++++++++++++++++++++++++++++++++- impls/vbs/step9_try.vbs | 11 ++++ impls/vbs/types.vbs | 51 +++++++++++++++- 3 files changed, 192 insertions(+), 2 deletions(-) diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index d9fec768b2..c80ad1c86a 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -219,6 +219,10 @@ Sub InitBuiltIn() 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)))" End Sub Function MReadStr(objArgs, objEnv) @@ -444,4 +448,130 @@ Function MThrow(objArgs, objEnv) Err.Raise vbObjectError, _ "MThrow", strRnd End Function -objNS.Add NewMalSym("throw"), NewVbsProc("MThrow", False) \ No newline at end of file +objNS.Add NewMalSym("throw"), NewVbsProc("MThrow", True) + +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) \ No newline at end of file diff --git a/impls/vbs/step9_try.vbs b/impls/vbs/step9_try.vbs index 136f3c96a7..5c4c7d4332 100644 --- a/impls/vbs/step9_try.vbs +++ b/impls/vbs/step9_try.vbs @@ -309,6 +309,17 @@ 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 diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs index b0cc09bc06..71f07c8bbd 100644 --- a/impls/vbs/types.vbs +++ b/impls/vbs/types.vbs @@ -248,6 +248,13 @@ Class VbsProcedure 'Extends MalType End If Set Apply = varResult End Function + + Public Function ApplyWithoutEval(objArgs, objEnv) + Dim varResult + Set varResult = Value(objArgs, objEnv) + + Set ApplyWithoutEval = varResult + End Function End Class Function NewVbsProc(strFnName, boolSpec) @@ -363,7 +370,49 @@ Class MalProcedure 'Extends MalType ' EvalLater -> Evaluate Set varRet = Evaluate(objCode, objNewEnv) - Set MacroApply = varRet + Set ApplyWithoutEval = 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 End Class From f2cab28ac96da37be76e559eb9c7777476a552fa Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sat, 28 Jan 2023 01:11:37 +0800 Subject: [PATCH 039/129] vbs: step9 pass! --- impls/vbs/core.vbs | 134 ++++++++++++++++++++++++++++++++++++++-- impls/vbs/step9_try.vbs | 2 +- impls/vbs/types.vbs | 71 ++++++++++++++++++--- 3 files changed, 194 insertions(+), 13 deletions(-) diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index c80ad1c86a..32ae52e13c 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -119,7 +119,7 @@ Function MEqual(objArgs, objEnv) boolResult = boolResult And _ MEqual(NewMalList(Array(Nothing, _ objArgs.Item(1).Item(i), _ - objArgs.Item(2).Item(i)))).Value + objArgs.Item(2).Item(i))), objEnv).Value Next Set varRet = NewMalBool(boolResult) End If @@ -129,8 +129,27 @@ Function MEqual(objArgs, objEnv) Else Select Case objArgs.Item(1).Type Case TYPES.HASHMAP - Err.Raise vbObjectError, _ - "MEqual", "Not implement yet~" + '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) @@ -223,6 +242,7 @@ Sub InitBuiltIn() 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))))" End Sub Function MReadStr(objArgs, objEnv) @@ -574,4 +594,110 @@ Function MIsMap(objArgs, objEnv) Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.HASHMAP) Set MIsMap = varRes End Function -objNS.Add NewMalSym("map?"), NewVbsProc("MIsMap", False) \ No newline at end of file +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 MVals +' objNS.Add NewMalSym("vals"), NewVbsProc("MVals", 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) \ No newline at end of file diff --git a/impls/vbs/step9_try.vbs b/impls/vbs/step9_try.vbs index 5c4c7d4332..b30ca0e424 100644 --- a/impls/vbs/step9_try.vbs +++ b/impls/vbs/step9_try.vbs @@ -392,7 +392,7 @@ Sub REPL() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 - On Error Resume Next + 'On Error Resume Next WScript.Echo REP(strCode) If Err.Number <> 0 Then If Err.Source = "MThrow" Then diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs index 71f07c8bbd..092a1a5f7e 100644 --- a/impls/vbs/types.vbs +++ b/impls/vbs/types.vbs @@ -183,16 +183,60 @@ Class MalHashmap 'Extends MalType Public Function Init(arrKeys, arrValues) Dim i For i = 0 To UBound(arrKeys) - .Add arrKeys(i), arrValues(i) + 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) - Value.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() - Keys = Value.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() @@ -200,15 +244,26 @@ Class MalHashmap 'Extends MalType End Function Public Property Get Item(i) - Set Item = Value.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(i) = varValue + wsh.echo 2 + Value.Item(M2S(i)) = varValue End Property Public Property Set Item(i, varValue) - Set Value.Item(i) = varValue + wsh.echo 1 + Set Value.Item(M2S(i)) = varValue End Property End Class @@ -370,7 +425,7 @@ Class MalProcedure 'Extends MalType ' EvalLater -> Evaluate Set varRet = Evaluate(objCode, objNewEnv) - Set ApplyWithoutEval = varRet + Set MacroApply = varRet End Function From 2bb3edad6cf9c6fff295e36f08cddfc0833780f2 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sat, 28 Jan 2023 13:51:46 +0800 Subject: [PATCH 040/129] vbs: STEPA FINISH!!! --- impls/vbs/core.vbs | 174 ++++++++++++- impls/vbs/step8_macros.vbs | 2 +- impls/vbs/step9_try.vbs | 4 +- impls/vbs/stepA_mal.vbs | 505 +++++++++++++++++++++++++++++++++++++ impls/vbs/types.vbs | 131 +++++++++- 5 files changed, 803 insertions(+), 13 deletions(-) create mode 100644 impls/vbs/stepA_mal.vbs diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index 32ae52e13c..71a79b12ba 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -243,6 +243,7 @@ Sub InitBuiltIn() 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* ""Visual Basic Script"")" End Sub Function MReadStr(objArgs, objEnv) @@ -333,7 +334,7 @@ Function MSwap(objArgs, objEnv) objProg.Add objArgs.Item(i) Next - objAtom.Reset Evaluate(objProg, objEnv) + objAtom.Reset objFn.ApplyWithoutEval(objProg, objEnv) Set varRes = objAtom.Value Set MSwap = varRes End Function @@ -435,7 +436,10 @@ 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 "(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 @@ -630,7 +634,6 @@ Function MAssoc(objArgs, objEnv) 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) @@ -691,13 +694,170 @@ Function MKeys(objArgs, objEnv) End Function objNS.Add NewMalSym("keys"), NewVbsProc("MKeys", False) -' Function MVals -' objNS.Add NewMalSym("vals"), NewVbsProc("MVals", 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) \ No newline at end of file +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) + diff --git a/impls/vbs/step8_macros.vbs b/impls/vbs/step8_macros.vbs index 94e98d0edc..5a71f23b16 100644 --- a/impls/vbs/step8_macros.vbs +++ b/impls/vbs/step8_macros.vbs @@ -258,7 +258,7 @@ Function MDefMacro(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.SYMBOL - Set varRet = Evaluate(objArgs.Item(2), objEnv) + Set varRet = Evaluate(objArgs.Item(2), objEnv).Copy() CheckType varRet, TYPES.PROCEDURE varRet.IsMacro = True objEnv.Add objArgs.Item(1), varRet diff --git a/impls/vbs/step9_try.vbs b/impls/vbs/step9_try.vbs index b30ca0e424..77d504277e 100644 --- a/impls/vbs/step9_try.vbs +++ b/impls/vbs/step9_try.vbs @@ -258,7 +258,7 @@ Function MDefMacro(objArgs, objEnv) Dim varRet CheckArgNum objArgs, 2 CheckType objArgs.Item(1), TYPES.SYMBOL - Set varRet = Evaluate(objArgs.Item(2), objEnv) + Set varRet = Evaluate(objArgs.Item(2), objEnv).Copy() CheckType varRet, TYPES.PROCEDURE varRet.IsMacro = True objEnv.Add objArgs.Item(1), varRet @@ -392,7 +392,7 @@ Sub REPL() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 - 'On Error Resume Next + On Error Resume Next WScript.Echo REP(strCode) If Err.Number <> 0 Then If Err.Source = "MThrow" Then diff --git a/impls/vbs/stepA_mal.vbs b/impls/vbs/stepA_mal.vbs new file mode 100644 index 0000000000..637123e732 --- /dev/null +++ b/impls/vbs/stepA_mal.vbs @@ -0,0 +1,505 @@ +Option Explicit + +Include "Types.vbs" +Include "Reader.vbs" +Include "Printer.vbs" +Include "Env.vbs" +Include "Core.vbs" + +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() + + Set varRes = Evaluate(NewMalList(Array( _ + NewMalSym("let*"), NewMalList(Array( _ + objCatch.Item(1), objException)), _ + objCatch.Item(2))), objEnv) + End If + On Error Goto 0 + + 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) + """)" + End If +End Sub + +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 + + On Error Resume Next + WScript.Echo REP(strCode) + If Err.Number <> 0 Then + If Err.Source = "MThrow" Then + WScript.StdErr.WriteLine Err.Source + ": " + _ + PrintMalType(objExceptions.Item(Err.Description), True) + objExceptions.Remove Err.Description + Else + WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + 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 diff --git a/impls/vbs/types.vbs b/impls/vbs/types.vbs index 092a1a5f7e..0c08c95e8f 100644 --- a/impls/vbs/types.vbs +++ b/impls/vbs/types.vbs @@ -26,6 +26,23 @@ 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 @@ -66,6 +83,23 @@ 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 @@ -87,6 +121,24 @@ 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") @@ -131,6 +183,24 @@ 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") @@ -175,6 +245,25 @@ 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") @@ -257,12 +346,10 @@ Class MalHashmap 'Extends MalType End Function Public Property Let Item(i, varValue) - wsh.echo 2 Value.Item(M2S(i)) = varValue End Property Public Property Set Item(i, varValue) - wsh.echo 1 Set Value.Item(M2S(i)) = varValue End Property End Class @@ -280,9 +367,11 @@ Class VbsProcedure 'Extends MalType Public IsMacro Public boolSpec + Public MetaData Private Sub Class_Initialize [Type] = TYPES.PROCEDURE IsMacro = False + Set MetaData = NewMalNil() End Sub Public Property Get IsSpecial() @@ -310,6 +399,16 @@ Class VbsProcedure 'Extends MalType 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) @@ -329,12 +428,14 @@ Class MalProcedure 'Extends MalType IsSpecial = False End Property + Public MetaData Private Sub Class_Initialize [Type] = TYPES.PROCEDURE IsMacro = False + Set MetaData = NewMalNil() End Sub - Private objParams, objCode, objSavedEnv + Public objParams, objCode, objSavedEnv Public Function Init(objP, objC, objE) Set objParams = objP Set objCode = objC @@ -469,6 +570,19 @@ Class MalProcedure 'Extends MalType 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) @@ -484,4 +598,15 @@ Function NewMalMacro(objParams, objCode, objEnv) 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 \ No newline at end of file From d725374990804a20cc3223ac1b9315e56c1c3ef5 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sat, 28 Jan 2023 23:33:10 +0800 Subject: [PATCH 041/129] vbs: fix (rest nil) try+catch+throw 's bugs --- impls/vbs/core.vbs | 9 ++++-- impls/vbs/step6_file.vbs | 1 + impls/vbs/step7_quote.vbs | 1 + impls/vbs/step8_macros.vbs | 1 + impls/vbs/step9_try.vbs | 41 ++++++++++++++----------- impls/vbs/stepA_mal.vbs | 49 ++++++++++++++++++------------ impls/vbs/tests/step4_if_fn_do.mal | 6 ++++ impls/vbs/tests/step9_try.mal | 4 +++ 8 files changed, 73 insertions(+), 39 deletions(-) create mode 100644 impls/vbs/tests/step4_if_fn_do.mal create mode 100644 impls/vbs/tests/step9_try.mal diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index 71a79b12ba..ade713324f 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -243,7 +243,7 @@ Sub InitBuiltIn() 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* ""Visual Basic Script"")" + REP "(def! *host-language* ""VBScript"")" End Sub Function MReadStr(objArgs, objEnv) @@ -252,6 +252,9 @@ Function MReadStr(objArgs, objEnv) 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) @@ -415,7 +418,7 @@ Function MRest(objArgs, objEnv) CheckArgNum objArgs, 1 If objArgs.Item(1).Type = TYPES.NIL Then - Set varRes = NewMalNil() + Set varRes = NewMalList(Array()) Set MRest = varRes Exit Function End If @@ -472,7 +475,7 @@ Function MThrow(objArgs, objEnv) Err.Raise vbObjectError, _ "MThrow", strRnd End Function -objNS.Add NewMalSym("throw"), NewVbsProc("MThrow", True) +objNS.Add NewMalSym("throw"), NewVbsProc("MThrow", False) Function MApply(objArgs, objEnv) Dim varRes diff --git a/impls/vbs/step6_file.vbs b/impls/vbs/step6_file.vbs index 4c0e7955a0..3829e790ef 100644 --- a/impls/vbs/step6_file.vbs +++ b/impls/vbs/step6_file.vbs @@ -146,6 +146,7 @@ Sub InitArgs() If WScript.Arguments.Count > 0 Then REP "(load-file """ + WScript.Arguments.Item(0) + """)" + WScript.Quit 0 End If End Sub diff --git a/impls/vbs/step7_quote.vbs b/impls/vbs/step7_quote.vbs index 5d3ed5b84e..c22120f4cd 100644 --- a/impls/vbs/step7_quote.vbs +++ b/impls/vbs/step7_quote.vbs @@ -270,6 +270,7 @@ Sub InitArgs() If WScript.Arguments.Count > 0 Then REP "(load-file """ + WScript.Arguments.Item(0) + """)" + WScript.Quit 0 End If End Sub diff --git a/impls/vbs/step8_macros.vbs b/impls/vbs/step8_macros.vbs index 5a71f23b16..ad3a4e64b2 100644 --- a/impls/vbs/step8_macros.vbs +++ b/impls/vbs/step8_macros.vbs @@ -324,6 +324,7 @@ Sub InitArgs() If WScript.Arguments.Count > 0 Then REP "(load-file """ + WScript.Arguments.Item(0) + """)" + WScript.Quit 0 End If End Sub diff --git a/impls/vbs/step9_try.vbs b/impls/vbs/step9_try.vbs index 77d504277e..42d0c30cde 100644 --- a/impls/vbs/step9_try.vbs +++ b/impls/vbs/step9_try.vbs @@ -337,25 +337,31 @@ Function MTry(objArgs, objEnv) 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() + Set varRes = Evaluate(objTry, objEnv) + If Err.Number <> 0 Then + Dim objException - Set varRes = Evaluate(NewMalList(Array( _ - NewMalSym("let*"), NewMalList(Array( _ - objCatch.Item(1), objException)), _ - objCatch.Item(2))), objEnv) + If Err.Source <> "MThrow" Then + Set objException = NewMalStr(Err.Description) + Else + Set objException = objExceptions.Item(Err.Description) + objExceptions.Remove Err.Description End If - On Error Goto 0 + + 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 @@ -378,6 +384,7 @@ Sub InitArgs() If WScript.Arguments.Count > 0 Then REP "(load-file """ + WScript.Arguments.Item(0) + """)" + WScript.Quit 0 End If End Sub diff --git a/impls/vbs/stepA_mal.vbs b/impls/vbs/stepA_mal.vbs index 637123e732..7a322a1d98 100644 --- a/impls/vbs/stepA_mal.vbs +++ b/impls/vbs/stepA_mal.vbs @@ -337,25 +337,31 @@ Function MTry(objArgs, objEnv) 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() + Set varRes = Evaluate(objTry, objEnv) + If Err.Number <> 0 Then + Dim objException - Set varRes = Evaluate(NewMalList(Array( _ - NewMalSym("let*"), NewMalList(Array( _ - objCatch.Item(1), objException)), _ - objCatch.Item(2))), objEnv) + If Err.Source <> "MThrow" Then + Set objException = NewMalStr(Err.Description) + Else + Set objException = objExceptions.Item(Err.Description) + objExceptions.Remove Err.Description End If - On Error Goto 0 + + 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 @@ -378,6 +384,7 @@ Sub InitArgs() If WScript.Arguments.Count > 0 Then REP "(load-file """ + WScript.Arguments.Item(0) + """)" + WScript.Quit 0 End If End Sub @@ -392,9 +399,13 @@ Sub REPL() strCode = WScript.StdIn.ReadLine() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 - + + Dim strRes On Error Resume Next - WScript.Echo REP(strCode) + strRes = REP(strCode) + If strRes <> "" Then + WScript.Echo strRes + End If If Err.Number <> 0 Then If Err.Source = "MThrow" Then WScript.StdErr.WriteLine Err.Source + ": " + _ diff --git a/impls/vbs/tests/step4_if_fn_do.mal b/impls/vbs/tests/step4_if_fn_do.mal new file mode 100644 index 0000000000..8697f6beec --- /dev/null +++ b/impls/vbs/tests/step4_if_fn_do.mal @@ -0,0 +1,6 @@ +((fn* [x] [x]) (list 1 2 3)) +((fn* [x] [x]) [1 2 3]) +((fn* [x] (list x)) (list 1 2 3)) +((fn* [x] (list x)) [1 2 3]) +((fn* [x] x) (list 1 2 3)) +((fn* [x] x) [1 2 3]) \ No newline at end of file diff --git a/impls/vbs/tests/step9_try.mal b/impls/vbs/tests/step9_try.mal new file mode 100644 index 0000000000..4217ffb7ac --- /dev/null +++ b/impls/vbs/tests/step9_try.mal @@ -0,0 +1,4 @@ +(throw (list 1 2 3)) +(try* (throw {}) (catch* e (do (prn e) (throw e)))) +(try* (throw (list 1 2 3)) (catch* exc (do (prn "err:" exc) 7))) +(try* (map throw (list "my err")) (catch* exc exc)) From 02eb37ae2134749e6056c47a92714e3a64158212 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sun, 29 Jan 2023 00:13:45 +0800 Subject: [PATCH 042/129] vbs: rewrite error strings & remove my debug error info --- impls/vbs/core.vbs | 2 +- impls/vbs/env.vbs | 2 +- impls/vbs/reader.vbs | 22 +++++++++++----------- impls/vbs/step1_read_print.vbs | 9 +++++++-- impls/vbs/step2_eval.vbs | 9 +++++++-- impls/vbs/step3_env.vbs | 9 +++++++-- impls/vbs/step4_if_fn_do.vbs | 9 +++++++-- impls/vbs/step5_tco.vbs | 9 +++++++-- impls/vbs/step6_file.vbs | 9 +++++++-- impls/vbs/step7_quote.vbs | 9 +++++++-- impls/vbs/step8_macros.vbs | 9 +++++++-- impls/vbs/step9_try.vbs | 12 +++++++++--- impls/vbs/stepA_mal.vbs | 6 ++++-- 13 files changed, 82 insertions(+), 34 deletions(-) diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index ade713324f..5ec631ca81 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -384,7 +384,7 @@ Function MNth(objArgs, objEnv) Set varRes = objArgs.Item(1).Item(objArgs.Item(2).Value) Else Err.Raise vbObjectError, _ - "MNth", "Index out of bound." + "MNth", "Index out of bounds." End If Set MNth = varRes diff --git a/impls/vbs/env.vbs b/impls/vbs/env.vbs index 8bddd93919..c86671b478 100644 --- a/impls/vbs/env.vbs +++ b/impls/vbs/env.vbs @@ -42,7 +42,7 @@ Class Environment Set varRet = objOuter.Find(varKey) Else Err.Raise vbObjectError, _ - "Environment", "Symbol '" + varKey.Value + "' not found." + "Environment", "'" + varKey.Value + "' not found" End If End If diff --git a/impls/vbs/reader.vbs b/impls/vbs/reader.vbs index f258ca0a52..7c6c9dfcb2 100644 --- a/impls/vbs/reader.vbs +++ b/impls/vbs/reader.vbs @@ -6,7 +6,7 @@ Function ReadString(strCode) Set ReadString = ReadForm(objTokens) If Not objTokens.AtEnd() Then Err.Raise vbObjectError, _ - "ReadForm", "Extra token '" + objTokens.Current() + "'." + "ReadForm", "extra token '" + objTokens.Current() + "'." End If End Function @@ -91,7 +91,7 @@ Function ReadForm(objTokens) ' Return Nothing / MalType Set varResult = ReadSpecial(objTokens) ElseIf InStr(")]}", strToken) Then Err.Raise vbObjectError, _ - "ReadForm", "Unbalanced parentheses." + "ReadForm", "unbalanced parentheses." ElseIf strToken = "^" Then Set varResult = ReadMetadata(objTokens) Else @@ -132,7 +132,7 @@ Function ReadSpecial(objTokens) strAlias = "deref" Case Else Err.Raise vbObjectError, _ - "ReadSpecial", "Unknown token '" & strAlias & "'." + "ReadSpecial", "unknown token '" & strAlias & "'." End Select Call objTokens.MoveToNext() @@ -149,7 +149,7 @@ Function ReadList(objTokens) If objTokens.AtEnd() Then Err.Raise vbObjectError, _ - "ReadList", "Unbalanced parentheses." + "ReadList", "unbalanced parentheses." End If Set varResult = NewMalList(Array()) @@ -161,7 +161,7 @@ Function ReadList(objTokens) If objTokens.MoveToNext() <> ")" Then Err.Raise vbObjectError, _ - "ReadList", "Unbalanced parentheses." + "ReadList", "unbalanced parentheses." End If Set ReadList = varResult @@ -173,7 +173,7 @@ Function ReadVector(objTokens) If objTokens.AtEnd() Then Err.Raise vbObjectError, _ - "ReadVector", "Unbalanced parentheses." + "ReadVector", "unbalanced parentheses." End If Set varResult = NewMalVec(Array()) @@ -185,7 +185,7 @@ Function ReadVector(objTokens) If objTokens.MoveToNext() <> "]" Then Err.Raise vbObjectError, _ - "ReadVector", "Unbalanced parentheses." + "ReadVector", "unbalanced parentheses." End If Set ReadVector = varResult @@ -197,7 +197,7 @@ Function ReadHashmap(objTokens) If objTokens.Count = 0 Then Err.Raise vbObjectError, _ - "ReadHashmap", "Unbalanced parentheses." + "ReadHashmap", "unbalanced parentheses." End If Set varResult = NewMalMap(Array(), Array()) @@ -212,7 +212,7 @@ Function ReadHashmap(objTokens) If objTokens.MoveToNext() <> "}" Then Err.Raise vbObjectError, _ - "ReadHashmap", "Unbalanced parentheses." + "ReadHashmap", "unbalanced parentheses." End If Set ReadHashmap = varResult @@ -252,7 +252,7 @@ End Function Function ParseString(strRaw) If Right(strRaw, 1) <> """" Or Len(strRaw) < 2 Then Err.Raise vbObjectError, _ - "ParseString", "Unterminated string, got EOF." + "ParseString", "unterminated string, got EOF." End If Dim strTemp @@ -281,7 +281,7 @@ Function ParseString(strRaw) ParseString = ParseString & Right(strTemp, 1) Else Err.Raise vbObjectError, _ - "ParseString", "Unterminated string, got EOF." + "ParseString", "unterminated string, got EOF." End If End If End Function diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index ececf82dfb..a54140ecd0 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -16,10 +16,15 @@ Sub REPL() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 + Dim strRes On Error Resume Next - WScript.Echo REP(strCode) + strRes = REP(strCode) + If strRes <> "" Then + WScript.Echo strRes + End If If Err.Number <> 0 Then - WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + WScript.StdErr.WriteLine "Exception: " + Err.Description End If On Error Goto 0 Wend diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs index b132000fe6..e6cad48176 100644 --- a/impls/vbs/step2_eval.vbs +++ b/impls/vbs/step2_eval.vbs @@ -99,10 +99,15 @@ Sub REPL() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 + Dim strRes On Error Resume Next - WScript.Echo REP(strCode) + strRes = REP(strCode) + If strRes <> "" Then + WScript.Echo strRes + End If If Err.Number <> 0 Then - WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + WScript.StdErr.WriteLine "Exception: " + Err.Description End If On Error Goto 0 Wend diff --git a/impls/vbs/step3_env.vbs b/impls/vbs/step3_env.vbs index bd6d4558dd..ddfaf39272 100644 --- a/impls/vbs/step3_env.vbs +++ b/impls/vbs/step3_env.vbs @@ -110,10 +110,15 @@ Sub REPL() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 + Dim strRes On Error Resume Next - WScript.Echo REP(strCode) + strRes = REP(strCode) + If strRes <> "" Then + WScript.Echo strRes + End If If Err.Number <> 0 Then - WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + WScript.StdErr.WriteLine "Exception: " + Err.Description End If On Error Goto 0 Wend diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs index 83e377415e..fc90594edf 100644 --- a/impls/vbs/step4_if_fn_do.vbs +++ b/impls/vbs/step4_if_fn_do.vbs @@ -124,10 +124,15 @@ Sub REPL() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 + Dim strRes On Error Resume Next - WScript.Echo REP(strCode) + strRes = REP(strCode) + If strRes <> "" Then + WScript.Echo strRes + End If If Err.Number <> 0 Then - WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + WScript.StdErr.WriteLine "Exception: " + Err.Description End If On Error Goto 0 Wend diff --git a/impls/vbs/step5_tco.vbs b/impls/vbs/step5_tco.vbs index 5462aa3d6b..bdba9e9688 100644 --- a/impls/vbs/step5_tco.vbs +++ b/impls/vbs/step5_tco.vbs @@ -133,10 +133,15 @@ Sub REPL() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 + Dim strRes On Error Resume Next - WScript.Echo REP(strCode) + strRes = REP(strCode) + If strRes <> "" Then + WScript.Echo strRes + End If If Err.Number <> 0 Then - WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + WScript.StdErr.WriteLine "Exception: " + Err.Description End If On Error Goto 0 Wend diff --git a/impls/vbs/step6_file.vbs b/impls/vbs/step6_file.vbs index 3829e790ef..1ca114a33e 100644 --- a/impls/vbs/step6_file.vbs +++ b/impls/vbs/step6_file.vbs @@ -161,10 +161,15 @@ Sub REPL() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 + Dim strRes On Error Resume Next - WScript.Echo REP(strCode) + strRes = REP(strCode) + If strRes <> "" Then + WScript.Echo strRes + End If If Err.Number <> 0 Then - WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + WScript.StdErr.WriteLine "Exception: " + Err.Description End If On Error Goto 0 Wend diff --git a/impls/vbs/step7_quote.vbs b/impls/vbs/step7_quote.vbs index c22120f4cd..6d6365c058 100644 --- a/impls/vbs/step7_quote.vbs +++ b/impls/vbs/step7_quote.vbs @@ -285,10 +285,15 @@ Sub REPL() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 + Dim strRes On Error Resume Next - WScript.Echo REP(strCode) + strRes = REP(strCode) + If strRes <> "" Then + WScript.Echo strRes + End If If Err.Number <> 0 Then - WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + WScript.StdErr.WriteLine "Exception: " + Err.Description End If On Error Goto 0 Wend diff --git a/impls/vbs/step8_macros.vbs b/impls/vbs/step8_macros.vbs index ad3a4e64b2..7b54d2f69d 100644 --- a/impls/vbs/step8_macros.vbs +++ b/impls/vbs/step8_macros.vbs @@ -339,10 +339,15 @@ Sub REPL() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 + Dim strRes On Error Resume Next - WScript.Echo REP(strCode) + strRes = REP(strCode) + If strRes <> "" Then + WScript.Echo strRes + End If If Err.Number <> 0 Then - WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description + WScript.StdErr.WriteLine "Exception: " + Err.Description End If On Error Goto 0 Wend diff --git a/impls/vbs/step9_try.vbs b/impls/vbs/step9_try.vbs index 42d0c30cde..6c309a9f8c 100644 --- a/impls/vbs/step9_try.vbs +++ b/impls/vbs/step9_try.vbs @@ -399,15 +399,21 @@ Sub REPL() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 + Dim strRes On Error Resume Next - WScript.Echo REP(strCode) + strRes = REP(strCode) + If strRes <> "" Then + WScript.Echo strRes + End If If Err.Number <> 0 Then If Err.Source = "MThrow" Then - WScript.StdErr.WriteLine Err.Source + ": " + _ + '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 Err.Source + ": " + Err.Description + WScript.StdErr.WriteLine "Exception: " + Err.Description End If End If On Error Goto 0 diff --git a/impls/vbs/stepA_mal.vbs b/impls/vbs/stepA_mal.vbs index 7a322a1d98..542f5f2695 100644 --- a/impls/vbs/stepA_mal.vbs +++ b/impls/vbs/stepA_mal.vbs @@ -408,11 +408,13 @@ Sub REPL() End If If Err.Number <> 0 Then If Err.Source = "MThrow" Then - WScript.StdErr.WriteLine Err.Source + ": " + _ + '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 Err.Source + ": " + Err.Description + WScript.StdErr.WriteLine "Exception: " + Err.Description End If End If On Error Goto 0 From 23f722ca64dceeaa268e298937cb5e7ebf25f26e Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sat, 8 Jul 2023 12:13:37 +0800 Subject: [PATCH 043/129] vbs: remove my ignore path --- .gitignore | 1 - 1 file changed, 1 deletion(-) diff --git a/.gitignore b/.gitignore index d1e4a10b77..7ecfa581fb 100644 --- a/.gitignore +++ b/.gitignore @@ -21,4 +21,3 @@ GRTAGS logs old tmp/ -impls/\#batch/* From e4a0e494016994c8384798362a8ad079adf4dd10 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sat, 8 Jul 2023 12:20:18 +0800 Subject: [PATCH 044/129] vbs: update readme --- README.md | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/README.md b/README.md index 6e0cf8609b..cf1b76f3d9 100644 --- a/README.md +++ b/README.md @@ -135,6 +135,7 @@ FAQ](docs/FAQ.md) where I attempt to answer some common questions. | [VHDL](#vhdl) | [Dov Murik](https://github.com/dubek) | | [Vimscript](#vimscript) | [Dov Murik](https://github.com/dubek) | | [Visual Basic.NET](#visual-basicnet) | [Joel Martin](https://github.com/kanaka) | +| [Visual Basic Script](#visual-basic-script) | [Baichao Liu](https://github.com/OldLiu001) | | [WebAssembly](#webassembly-wasm) (wasm) | [Joel Martin](https://github.com/kanaka) | | [Wren](#wren) | [Dov Murik](https://github.com/dubek) | | [XSLT](#xslt) | [Ali MohammadPur](https://github.com/alimpfard) | @@ -1231,6 +1232,19 @@ make mono ./stepX_YYY.exe ``` +### Visual Basic Script ### + +The VBScript implementation of mal has been tested on Windows 10 1909. +`install.vbs` can help you install the requirements (.NET 2.0 3.0 3.5). +If you havn't install `.NET 2.0 3.0 3.5`, it will popup a window for installation. +If you already installed that, it will do nothing. + +``` +cd impls\vbs +install.vbs +cscript -nologo stepX_YYY.vbs +``` + ### WebAssembly (wasm) ### The WebAssembly implementation is written in From 9c6bcd860a478b5a5df36ae3090f61e88af8a8e6 Mon Sep 17 00:00:00 2001 From: OldLiu <632171029@qq.com> Date: Sat, 8 Jul 2023 13:03:26 +0800 Subject: [PATCH 045/129] vbs: fix print privous return value in repl error --- impls/vbs/step1_read_print.vbs | 7 ++++--- impls/vbs/step2_eval.vbs | 7 ++++--- impls/vbs/step3_env.vbs | 7 ++++--- impls/vbs/step4_if_fn_do.vbs | 7 ++++--- impls/vbs/step5_tco.vbs | 7 ++++--- impls/vbs/step6_file.vbs | 7 ++++--- impls/vbs/step7_quote.vbs | 7 ++++--- impls/vbs/step8_macros.vbs | 7 ++++--- impls/vbs/step9_try.vbs | 7 ++++--- impls/vbs/stepA_mal.vbs | 7 ++++--- 10 files changed, 40 insertions(+), 30 deletions(-) diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index a54140ecd0..01757b6e14 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -19,12 +19,13 @@ Sub REPL() Dim strRes On Error Resume Next strRes = REP(strCode) - If strRes <> "" Then - WScript.Echo strRes - End If If Err.Number <> 0 Then 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description WScript.StdErr.WriteLine "Exception: " + Err.Description + Else + If strRes <> "" Then + WScript.Echo strRes + End If End If On Error Goto 0 Wend diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs index e6cad48176..769a342697 100644 --- a/impls/vbs/step2_eval.vbs +++ b/impls/vbs/step2_eval.vbs @@ -102,12 +102,13 @@ Sub REPL() Dim strRes On Error Resume Next strRes = REP(strCode) - If strRes <> "" Then - WScript.Echo strRes - End If If Err.Number <> 0 Then 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description WScript.StdErr.WriteLine "Exception: " + Err.Description + Else + If strRes <> "" Then + WScript.Echo strRes + End If End If On Error Goto 0 Wend diff --git a/impls/vbs/step3_env.vbs b/impls/vbs/step3_env.vbs index ddfaf39272..eedff1a996 100644 --- a/impls/vbs/step3_env.vbs +++ b/impls/vbs/step3_env.vbs @@ -113,12 +113,13 @@ Sub REPL() Dim strRes On Error Resume Next strRes = REP(strCode) - If strRes <> "" Then - WScript.Echo strRes - End If If Err.Number <> 0 Then 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description WScript.StdErr.WriteLine "Exception: " + Err.Description + Else + If strRes <> "" Then + WScript.Echo strRes + End If End If On Error Goto 0 Wend diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs index fc90594edf..d9cb2e890b 100644 --- a/impls/vbs/step4_if_fn_do.vbs +++ b/impls/vbs/step4_if_fn_do.vbs @@ -127,12 +127,13 @@ Sub REPL() Dim strRes On Error Resume Next strRes = REP(strCode) - If strRes <> "" Then - WScript.Echo strRes - End If If Err.Number <> 0 Then 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description WScript.StdErr.WriteLine "Exception: " + Err.Description + Else + If strRes <> "" Then + WScript.Echo strRes + End If End If On Error Goto 0 Wend diff --git a/impls/vbs/step5_tco.vbs b/impls/vbs/step5_tco.vbs index bdba9e9688..3b77ecac35 100644 --- a/impls/vbs/step5_tco.vbs +++ b/impls/vbs/step5_tco.vbs @@ -136,12 +136,13 @@ Sub REPL() Dim strRes On Error Resume Next strRes = REP(strCode) - If strRes <> "" Then - WScript.Echo strRes - End If If Err.Number <> 0 Then 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description WScript.StdErr.WriteLine "Exception: " + Err.Description + Else + If strRes <> "" Then + WScript.Echo strRes + End If End If On Error Goto 0 Wend diff --git a/impls/vbs/step6_file.vbs b/impls/vbs/step6_file.vbs index 1ca114a33e..c7cb37baa8 100644 --- a/impls/vbs/step6_file.vbs +++ b/impls/vbs/step6_file.vbs @@ -164,12 +164,13 @@ Sub REPL() Dim strRes On Error Resume Next strRes = REP(strCode) - If strRes <> "" Then - WScript.Echo strRes - End If If Err.Number <> 0 Then 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description WScript.StdErr.WriteLine "Exception: " + Err.Description + Else + If strRes <> "" Then + WScript.Echo strRes + End If End If On Error Goto 0 Wend diff --git a/impls/vbs/step7_quote.vbs b/impls/vbs/step7_quote.vbs index 6d6365c058..4dadef08ef 100644 --- a/impls/vbs/step7_quote.vbs +++ b/impls/vbs/step7_quote.vbs @@ -288,12 +288,13 @@ Sub REPL() Dim strRes On Error Resume Next strRes = REP(strCode) - If strRes <> "" Then - WScript.Echo strRes - End If If Err.Number <> 0 Then 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description WScript.StdErr.WriteLine "Exception: " + Err.Description + Else + If strRes <> "" Then + WScript.Echo strRes + End If End If On Error Goto 0 Wend diff --git a/impls/vbs/step8_macros.vbs b/impls/vbs/step8_macros.vbs index 7b54d2f69d..ed02107a3d 100644 --- a/impls/vbs/step8_macros.vbs +++ b/impls/vbs/step8_macros.vbs @@ -342,12 +342,13 @@ Sub REPL() Dim strRes On Error Resume Next strRes = REP(strCode) - If strRes <> "" Then - WScript.Echo strRes - End If If Err.Number <> 0 Then 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description WScript.StdErr.WriteLine "Exception: " + Err.Description + Else + If strRes <> "" Then + WScript.Echo strRes + End If End If On Error Goto 0 Wend diff --git a/impls/vbs/step9_try.vbs b/impls/vbs/step9_try.vbs index 6c309a9f8c..8b4af962e0 100644 --- a/impls/vbs/step9_try.vbs +++ b/impls/vbs/step9_try.vbs @@ -402,9 +402,6 @@ Sub REPL() Dim strRes On Error Resume Next strRes = REP(strCode) - If strRes <> "" Then - WScript.Echo strRes - End If If Err.Number <> 0 Then If Err.Source = "MThrow" Then 'WScript.StdErr.WriteLine Err.Source + ": " + _ @@ -415,6 +412,10 @@ Sub REPL() '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 diff --git a/impls/vbs/stepA_mal.vbs b/impls/vbs/stepA_mal.vbs index 542f5f2695..d6bc3f3d5b 100644 --- a/impls/vbs/stepA_mal.vbs +++ b/impls/vbs/stepA_mal.vbs @@ -403,9 +403,6 @@ Sub REPL() Dim strRes On Error Resume Next strRes = REP(strCode) - If strRes <> "" Then - WScript.Echo strRes - End If If Err.Number <> 0 Then If Err.Source = "MThrow" Then 'WScript.StdErr.WriteLine Err.Source + ": " + _ @@ -416,6 +413,10 @@ Sub REPL() '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 From fdcc1124a54d2c39426edfaf99fdda171c9e238e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 11:58:34 +0800 Subject: [PATCH 046/129] vbs: update get-ci-matrix to support windows system --- get-ci-matrix.py | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/get-ci-matrix.py b/get-ci-matrix.py index 56f30dd77d..1ba47baafd 100755 --- a/get-ci-matrix.py +++ b/get-ci-matrix.py @@ -49,13 +49,16 @@ def impl_text(impl): # Load the full implementation description file all_impls = yaml.safe_load(open(IMPLS_FILE)) -# Accumulate and output linux and macos implementations separately +# Accumulate and output linux, macos & windows implementations separately linux_impls = [] macos_impls = [] +windows_impls = [] for impl in all_impls['IMPL']: targ = linux_impls if 'OS' in impl and impl['OS'] == 'macos': targ = macos_impls + if 'OS' in impl and impl['OS'] == 'windows': + targ = windows_impls # Run implementations with actual changes first before running # other impls triggered by non-impl code changes if impl['IMPL'] in run_impls: @@ -65,5 +68,7 @@ def impl_text(impl): print("do_linux=%s" % json.dumps(len(linux_impls)>0)) print("do_macos=%s" % json.dumps(len(macos_impls)>0)) +print("do_windows=%s" % json.dumps(len(windows_impls)>0)) print("linux={\"IMPL\":%s}" % json.dumps(linux_impls)) print("macos={\"IMPL\":%s}" % json.dumps(macos_impls)) +print("windows={\"IMPL\":%s}" % json.dumps(windows_impls)) From 66ca4a8092594d690230df1110e8312f7d6f9cf1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 12:01:17 +0800 Subject: [PATCH 047/129] vbs: fix indentation error --- get-ci-matrix.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/get-ci-matrix.py b/get-ci-matrix.py index 1ba47baafd..451728d1e1 100755 --- a/get-ci-matrix.py +++ b/get-ci-matrix.py @@ -57,8 +57,8 @@ def impl_text(impl): targ = linux_impls if 'OS' in impl and impl['OS'] == 'macos': targ = macos_impls - if 'OS' in impl and impl['OS'] == 'windows': - targ = windows_impls + if 'OS' in impl and impl['OS'] == 'windows': + targ = windows_impls # Run implementations with actual changes first before running # other impls triggered by non-impl code changes if impl['IMPL'] in run_impls: From f346c4fe2459bd5bc2135a4a4e2791af31acff46 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 12:07:02 +0800 Subject: [PATCH 048/129] vbs: update github action's configuration for Windows support --- .github/workflows/main.yml | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 6f7c5ebf43..2b0fddd0bd 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -139,3 +139,36 @@ jobs: path: | *.log *.debug + + windows: + needs: get-matrix + if: ${{ needs.get-matrix.outputs.do-windows == 'true' }} + runs-on: windows-2022 + strategy: + fail-fast: false + matrix: ${{ fromJson(needs.get-matrix.outputs.matrix-windows) }} + steps: + - uses: actions/checkout@v4 + - name: Build + run: | + export ${{ matrix.IMPL }} + ./ci.sh build ${IMPL} + - name: Step Tests + run: | + export ${{ matrix.IMPL }} + ./ci.sh test ${IMPL} + - name: Regression Tests + run: | + export ${{ matrix.IMPL }} + STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} + - name: Performance Tests + run: | + export ${{ matrix.IMPL }} + ./ci.sh perf ${IMPL} + - name: Archive logs and debug output + uses: actions/upload-artifact@v4 + with: + name: logs.${{ matrix.IMPL }} + path: | + *.log + *.debug From 2bc3323f792ae1b7772a98ddad03e96c0ccd6bf1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 12:09:31 +0800 Subject: [PATCH 049/129] vbs: add vbs impl to IMPLS.yml --- IMPLS.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/IMPLS.yml b/IMPLS.yml index 1421b0bba2..f36c4d716b 100644 --- a/IMPLS.yml +++ b/IMPLS.yml @@ -1,4 +1,5 @@ IMPL: + - {IMPL: vbs, NO_DOCKER: 1, OS: windows} # place it first for quick feedback - {IMPL: ada} - {IMPL: ada.2} - {IMPL: awk} From 9b8d69f097eeafbb7f563e8cdaeae6f691226991 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 12:16:55 +0800 Subject: [PATCH 050/129] vbs: comment other tests for faster ci test --- IMPLS.yml | 242 +++++++++++++++++++++++++++--------------------------- 1 file changed, 121 insertions(+), 121 deletions(-) diff --git a/IMPLS.yml b/IMPLS.yml index f36c4d716b..a08bbb64f2 100644 --- a/IMPLS.yml +++ b/IMPLS.yml @@ -1,124 +1,124 @@ IMPL: - {IMPL: vbs, NO_DOCKER: 1, OS: windows} # place it first for quick feedback - - {IMPL: ada} - - {IMPL: ada.2} - - {IMPL: awk} - - {IMPL: bash, NO_SELF_HOST: 1} # step8 timeout - - {IMPL: basic, basic_MODE: cbm, NO_SELF_HOST: 1} # step4 OOM - - {IMPL: basic, basic_MODE: qbasic, NO_SELF_HOST: 1} # step4 OOM - - {IMPL: bbc-basic} - - {IMPL: c} - - {IMPL: c.2} - - {IMPL: cpp} - - {IMPL: coffee} - - {IMPL: cs} - - {IMPL: chuck, NO_SELF_HOST_PERF: 1} # perf OOM - - {IMPL: clojure, clojure_MODE: clj} - - {IMPL: clojure, clojure_MODE: cljs} - - {IMPL: common-lisp} - - {IMPL: crystal} - - {IMPL: d, d_MODE: gdc} - - {IMPL: d, d_MODE: ldc2} - - {IMPL: d, d_MODE: dmd} - - {IMPL: dart} - - {IMPL: elisp} - - {IMPL: elixir} - - {IMPL: elm} - - {IMPL: erlang, NO_SELF_HOST: 1} # step8 OOM - - {IMPL: es6} - - {IMPL: factor} - - {IMPL: fantom} - - {IMPL: fennel} - - {IMPL: forth} - - {IMPL: fsharp} - - {IMPL: go} - - {IMPL: groovy} - - {IMPL: gnu-smalltalk} - - {IMPL: guile} - - {IMPL: haskell} - - {IMPL: haxe, haxe_MODE: neko} - - {IMPL: haxe, haxe_MODE: python} - - {IMPL: haxe, haxe_MODE: cpp, SLOW: 1} - - {IMPL: haxe, haxe_MODE: js} - - {IMPL: hy} - - {IMPL: io, NO_SELF_HOST_PERF: 1} # perf OOM - - {IMPL: janet} - - {IMPL: java} - - {IMPL: java-truffle} - - {IMPL: jq} - - {IMPL: js} - - {IMPL: julia} - - {IMPL: kotlin} - - {IMPL: latex3, NO_PERF: 1, NO_SELF_HOST: 1, SLOW: 1} - - {IMPL: livescript} - - {IMPL: logo} - - {IMPL: lua} - - {IMPL: make, NO_SELF_HOST: 1} # step4 timeout - - {IMPL: mal, MAL_IMPL: js, BUILD_IMPL: js, NO_SELF_HOST: 1} - - {IMPL: mal, MAL_IMPL: js-mal, BUILD_IMPL: js, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} - - {IMPL: mal, MAL_IMPL: nim, BUILD_IMPL: nim, NO_SELF_HOST: 1} - - {IMPL: mal, MAL_IMPL: nim-mal, BUILD_IMPL: nim, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} - - {IMPL: matlab, NO_SELF_HOST_PERF: 1} # Octave, perf timeout - - {IMPL: miniMAL, NO_SELF_HOST_PERF: 1, SLOW: 1} # perf timeout - - {IMPL: nasm, NO_SELF_HOST_PERF: 1} # perf OOM - - {IMPL: nim} - - {IMPL: objpascal} - - {IMPL: objc} - - {IMPL: ocaml} - - {IMPL: perl} - - {IMPL: perl6} - - {IMPL: php} - - {IMPL: picolisp} - - {IMPL: pike} - - {IMPL: plpgsql, NO_SELF_HOST: 1, SLOW: 1} # step3 timeout -# - {IMPL: plsql} - - {IMPL: prolog} - - {IMPL: ps} - - {IMPL: powershell, NO_SELF_HOST_PERF: 1} - - {IMPL: purs} - - {IMPL: python, python_MODE: python2} - - {IMPL: python, python_MODE: python3} - - {IMPL: python.2} - - {IMPL: r} - - {IMPL: racket} - - {IMPL: rexx} - - {IMPL: rpython, SLOW: 1} - - {IMPL: ruby} - - {IMPL: ruby.2} - - {IMPL: rust} - - {IMPL: scala} - - {IMPL: scheme, scheme_MODE: chibi} - - {IMPL: scheme, scheme_MODE: kawa} - - {IMPL: scheme, scheme_MODE: gauche} - - {IMPL: scheme, scheme_MODE: chicken} - - {IMPL: scheme, scheme_MODE: sagittarius} - - {IMPL: scheme, scheme_MODE: cyclone} -# - {IMPL: scheme, scheme_MODE: foment} - - {IMPL: skew} - - {IMPL: sml, sml_MODE: polyml} - - {IMPL: sml, sml_MODE: mlton} - - {IMPL: sml, sml_MODE: mosml} - - {IMPL: tcl} - - {IMPL: ts} - - {IMPL: vala} - - {IMPL: vb} - - {IMPL: vhdl, NO_SELF_HOST_PERF: 1} # perf timeout - - {IMPL: vimscript} - # no self-host perf for wasm due to mac stack overflow - - {IMPL: wasm, wasm_MODE: wasmtime, NO_SELF_HOST_PERF: 1, NO_PERF: 1} - - {IMPL: wasm, wasm_MODE: wasmer, NO_SELF_HOST_PERF: 1, NO_PERF: 1} - #- {IMPL: wasm, wasm_MODE: wax, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions - - {IMPL: wasm, wasm_MODE: node, NO_SELF_HOST_PERF: 1, NO_PERF: 1} - #- {IMPL: wasm, wasm_MODE: warpy, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions - #- {IMPL: wasm, wasm_MODE: wace_libc, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions - - {IMPL: wren} - - {IMPL: xslt} - - {IMPL: yorick} - - {IMPL: zig} +# - {IMPL: ada} +# - {IMPL: ada.2} +# - {IMPL: awk} +# - {IMPL: bash, NO_SELF_HOST: 1} # step8 timeout +# - {IMPL: basic, basic_MODE: cbm, NO_SELF_HOST: 1} # step4 OOM +# - {IMPL: basic, basic_MODE: qbasic, NO_SELF_HOST: 1} # step4 OOM +# - {IMPL: bbc-basic} +# - {IMPL: c} +# - {IMPL: c.2} +# - {IMPL: cpp} +# - {IMPL: coffee} +# - {IMPL: cs} +# - {IMPL: chuck, NO_SELF_HOST_PERF: 1} # perf OOM +# - {IMPL: clojure, clojure_MODE: clj} +# - {IMPL: clojure, clojure_MODE: cljs} +# - {IMPL: common-lisp} +# - {IMPL: crystal} +# - {IMPL: d, d_MODE: gdc} +# - {IMPL: d, d_MODE: ldc2} +# - {IMPL: d, d_MODE: dmd} +# - {IMPL: dart} +# - {IMPL: elisp} +# - {IMPL: elixir} +# - {IMPL: elm} +# - {IMPL: erlang, NO_SELF_HOST: 1} # step8 OOM +# - {IMPL: es6} +# - {IMPL: factor} +# - {IMPL: fantom} +# - {IMPL: fennel} +# - {IMPL: forth} +# - {IMPL: fsharp} +# - {IMPL: go} +# - {IMPL: groovy} +# - {IMPL: gnu-smalltalk} +# - {IMPL: guile} +# - {IMPL: haskell} +# - {IMPL: haxe, haxe_MODE: neko} +# - {IMPL: haxe, haxe_MODE: python} +# - {IMPL: haxe, haxe_MODE: cpp, SLOW: 1} +# - {IMPL: haxe, haxe_MODE: js} +# - {IMPL: hy} +# - {IMPL: io, NO_SELF_HOST_PERF: 1} # perf OOM +# - {IMPL: janet} +# - {IMPL: java} +# - {IMPL: java-truffle} +# - {IMPL: jq} +# - {IMPL: js} +# - {IMPL: julia} +# - {IMPL: kotlin} +# - {IMPL: livescript} +# - {IMPL: logo} +# - {IMPL: lua} +# - {IMPL: make, NO_SELF_HOST: 1} # step4 timeout +# - {IMPL: mal, MAL_IMPL: js, BUILD_IMPL: js, NO_SELF_HOST: 1} +# - {IMPL: mal, MAL_IMPL: js-mal, BUILD_IMPL: js, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} +# - {IMPL: mal, MAL_IMPL: nim, BUILD_IMPL: nim, NO_SELF_HOST: 1} +# - {IMPL: mal, MAL_IMPL: nim-mal, BUILD_IMPL: nim, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} +# - {IMPL: matlab, NO_SELF_HOST_PERF: 1} # Octave, perf timeout +# - {IMPL: miniMAL, NO_SELF_HOST_PERF: 1, SLOW: 1} # perf timeout +# - {IMPL: nasm, NO_SELF_HOST_PERF: 1} # perf OOM +# - {IMPL: nim} +# - {IMPL: objpascal} +# - {IMPL: objc} +# - {IMPL: ocaml} +# - {IMPL: perl} +# - {IMPL: perl6} +# - {IMPL: php} +# - {IMPL: picolisp} +# - {IMPL: pike} +# - {IMPL: plpgsql, NO_SELF_HOST: 1, SLOW: 1} # step3 timeout +# # - {IMPL: plsql} +# - {IMPL: prolog} +# - {IMPL: ps} +# - {IMPL: powershell, NO_SELF_HOST_PERF: 1} +# - {IMPL: purs} +# - {IMPL: python, python_MODE: python2} +# - {IMPL: python, python_MODE: python3} +# - {IMPL: python.2} +# - {IMPL: r} +# - {IMPL: racket} +# - {IMPL: rexx} +# - {IMPL: rpython, SLOW: 1} +# - {IMPL: ruby} +# - {IMPL: ruby.2} +# - {IMPL: rust} +# - {IMPL: scala} +# - {IMPL: scheme, scheme_MODE: chibi} +# - {IMPL: scheme, scheme_MODE: kawa} +# - {IMPL: scheme, scheme_MODE: gauche} +# - {IMPL: scheme, scheme_MODE: chicken} +# - {IMPL: scheme, scheme_MODE: sagittarius} +# - {IMPL: scheme, scheme_MODE: cyclone} +# # - {IMPL: scheme, scheme_MODE: foment} +# - {IMPL: skew} +# - {IMPL: sml, sml_MODE: polyml} +# - {IMPL: sml, sml_MODE: mlton} +# - {IMPL: sml, sml_MODE: mosml} +# - {IMPL: tcl} +# - {IMPL: ts} +# - {IMPL: vala} +# - {IMPL: vb} +# - {IMPL: vhdl, NO_SELF_HOST_PERF: 1} # perf timeout +# - {IMPL: vimscript} +# # no self-host perf for wasm due to mac stack overflow +# - {IMPL: wasm, wasm_MODE: wasmtime, NO_SELF_HOST_PERF: 1, NO_PERF: 1} +# - {IMPL: wasm, wasm_MODE: wasmer, NO_SELF_HOST_PERF: 1, NO_PERF: 1} +# - {IMPL: wasm, wasm_MODE: lucet, NO_SELF_HOST_PERF: 1, NO_PERF: 1} +# #- {IMPL: wasm, wasm_MODE: wax, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions +# - {IMPL: wasm, wasm_MODE: node, NO_SELF_HOST_PERF: 1, NO_PERF: 1} +# #- {IMPL: wasm, wasm_MODE: warpy, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions +# #- {IMPL: wasm, wasm_MODE: wace_libc, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions +# - {IMPL: wren} +# - {IMPL: xslt} +# - {IMPL: yorick} +# - {IMPL: zig} - # See .travis.yml (for older osx / xcode tests) -# - {IMPL: objc, NO_DOCKER: 1, OS: xcode7}} -# - {IMPL: swift, NO_DOCKER: 1, OS: xcode7.3}} -# - {IMPL: swift3, NO_DOCKER: 1, OS: xcode8}} -# - {IMPL: swift4, NO_DOCKER: 1, OS: xcode10}} - - {IMPL: swift5, NO_DOCKER: 1, OS: macos} +# # See .travis.yml (for older osx / xcode tests) +# # - {IMPL: objc, NO_DOCKER: 1, OS: xcode7}} +# # - {IMPL: swift, NO_DOCKER: 1, OS: xcode7.3}} +# # - {IMPL: swift3, NO_DOCKER: 1, OS: xcode8}} +# # - {IMPL: swift4, NO_DOCKER: 1, OS: xcode10}} +# - {IMPL: swift5, NO_DOCKER: 1, OS: macos} From 3bf986771a6ccfe744a30710e22ab84ec2e2f64d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 12:19:02 +0800 Subject: [PATCH 051/129] vbs: each of the three systems retains a ci test to compare the outputs --- IMPLS.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/IMPLS.yml b/IMPLS.yml index a08bbb64f2..50b4b74449 100644 --- a/IMPLS.yml +++ b/IMPLS.yml @@ -1,6 +1,6 @@ IMPL: - {IMPL: vbs, NO_DOCKER: 1, OS: windows} # place it first for quick feedback -# - {IMPL: ada} + - {IMPL: ada} # - {IMPL: ada.2} # - {IMPL: awk} # - {IMPL: bash, NO_SELF_HOST: 1} # step8 timeout @@ -121,4 +121,4 @@ IMPL: # # - {IMPL: swift, NO_DOCKER: 1, OS: xcode7.3}} # # - {IMPL: swift3, NO_DOCKER: 1, OS: xcode8}} # # - {IMPL: swift4, NO_DOCKER: 1, OS: xcode10}} -# - {IMPL: swift5, NO_DOCKER: 1, OS: macos} + - {IMPL: swift5, NO_DOCKER: 1, OS: macos} From 1df72d8c357b3e657a079e9efa723a924367952e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 12:31:21 +0800 Subject: [PATCH 052/129] vbs: for quick testing, comment out the other languages and leave only the vbs ci --- IMPLS.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/IMPLS.yml b/IMPLS.yml index 50b4b74449..89eee4dbd6 100644 --- a/IMPLS.yml +++ b/IMPLS.yml @@ -1,6 +1,6 @@ IMPL: - {IMPL: vbs, NO_DOCKER: 1, OS: windows} # place it first for quick feedback - - {IMPL: ada} + # - {IMPL: ada} # - {IMPL: ada.2} # - {IMPL: awk} # - {IMPL: bash, NO_SELF_HOST: 1} # step8 timeout @@ -121,4 +121,4 @@ IMPL: # # - {IMPL: swift, NO_DOCKER: 1, OS: xcode7.3}} # # - {IMPL: swift3, NO_DOCKER: 1, OS: xcode8}} # # - {IMPL: swift4, NO_DOCKER: 1, OS: xcode10}} - - {IMPL: swift5, NO_DOCKER: 1, OS: macos} + # - {IMPL: swift5, NO_DOCKER: 1, OS: macos} From a0db83020202231bdc366af11301955b87ab077c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 12:31:40 +0800 Subject: [PATCH 053/129] vbs: add an 'run' script for vbs impl --- impls/vbs/run | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 impls/vbs/run diff --git a/impls/vbs/run b/impls/vbs/run new file mode 100644 index 0000000000..fc01d3541f --- /dev/null +++ b/impls/vbs/run @@ -0,0 +1,2 @@ +#!/bin/bash +exec cscript -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" From 8ac902b339ce50e347678b2ff9faff3557ba2b9d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 12:31:58 +0800 Subject: [PATCH 054/129] vbs: add vbs impl to Makefile.impls --- Makefile.impls | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Makefile.impls b/Makefile.impls index 1a3cbabca8..19ccdca846 100644 --- a/Makefile.impls +++ b/Makefile.impls @@ -39,7 +39,7 @@ IMPLS = ada ada.2 awk bash basic bbc-basic c c.2 chuck clojure coffee common-lis guile haskell haxe hy io janet java java-truffle js jq julia kotlin latex3 livescript logo lua make mal \ matlab miniMAL nasm nim objc objpascal ocaml perl perl6 php picolisp pike plpgsql \ plsql powershell prolog ps purs python python.2 r racket rexx rpython ruby ruby.2 rust scala scheme skew sml \ - swift swift3 swift4 swift5 tcl ts vala vb vhdl vimscript wasm wren yorick xslt zig + swift swift3 swift4 swift5 tcl ts vala vb vbs vhdl vimscript wasm wren yorick xslt zig step5_EXCLUDES += bash # never completes at 10,000 step5_EXCLUDES += basic # too slow, and limited to ints of 2^16 @@ -191,6 +191,7 @@ tcl_STEP_TO_PROG = impls/tcl/$($(1)).tcl ts_STEP_TO_PROG = impls/ts/$($(1)).js vala_STEP_TO_PROG = impls/vala/$($(1)) vb_STEP_TO_PROG = impls/vb/$($(1)).exe +vbs_STEP_TO_PROG = impls/vbs/$($(1)).vbs vhdl_STEP_TO_PROG = impls/vhdl/$($(1)) vimscript_STEP_TO_PROG = impls/vimscript/$($(1)).vim wasm_STEP_TO_PROG = impls/wasm/$($(1)).wasm From b57a4e83203b28208061234c910a1fbbe812a62c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 12:38:03 +0800 Subject: [PATCH 055/129] vbs: make do_full=True for testing --- get-ci-matrix.py | 1 + 1 file changed, 1 insertion(+) diff --git a/get-ci-matrix.py b/get-ci-matrix.py index 451728d1e1..49d99ca01f 100755 --- a/get-ci-matrix.py +++ b/get-ci-matrix.py @@ -34,6 +34,7 @@ def impl_text(impl): # If we have non-implementation code changes then we will add all # implementations to the test matrix +do_full = True if OVERRIDE_IMPLS: run_impls = OVERRIDE_IMPLS if 'all' in OVERRIDE_IMPLS: From 22eee3b4587e7db86130690188f2c9dafb90488b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 12:44:56 +0800 Subject: [PATCH 056/129] vbs: update github action's cfg for windows test support --- .github/workflows/main.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 2b0fddd0bd..78b19bb7d2 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -27,6 +27,8 @@ jobs: matrix-linux: ${{ steps.get-matrix-step.outputs.linux }} do-macos: ${{ steps.get-matrix-step.outputs.do_macos }} matrix-macos: ${{ steps.get-matrix-step.outputs.macos }} + do-windows: ${{ steps.get-matrix-step.outputs.do_windows }} + matrix-windows: ${{ steps.get-matrix-step.outputs.windows }} steps: - uses: actions/checkout@v4 - id: files From 2cf7738c4febd31c1b550f5be040aa1a469ab1d8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 12:50:09 +0800 Subject: [PATCH 057/129] vbs: change the default shell of windows for github action to bash --- .github/workflows/main.yml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 78b19bb7d2..75b4694d4e 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -155,18 +155,22 @@ jobs: run: | export ${{ matrix.IMPL }} ./ci.sh build ${IMPL} + shell: bash - name: Step Tests run: | export ${{ matrix.IMPL }} ./ci.sh test ${IMPL} + shell: bash - name: Regression Tests run: | export ${{ matrix.IMPL }} STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} + shell: bash - name: Performance Tests run: | export ${{ matrix.IMPL }} ./ci.sh perf ${IMPL} + shell: bash - name: Archive logs and debug output uses: actions/upload-artifact@v4 with: From 10437811fcc52ba1717fa819b18afd814fd1cef6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 12:55:06 +0800 Subject: [PATCH 058/129] vbs: add hello world to yml for debugging --- .github/workflows/main.yml | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 75b4694d4e..9a49ff2b04 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -152,25 +152,34 @@ jobs: steps: - uses: actions/checkout@v4 - name: Build + shell: bash run: | export ${{ matrix.IMPL }} ./ci.sh build ${IMPL} - shell: bash - name: Step Tests + shell: bash run: | + echo shell: bash, hello world from Step Tests + echo export ${{ matrix.IMPL }} + echo ./ci.sh test ${IMPL} export ${{ matrix.IMPL }} ./ci.sh test ${IMPL} - shell: bash - name: Regression Tests + shell: bash run: | + echo shell: bash, hello world from Regression Tests + echo export ${{ matrix.IMPL }} + echo STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} export ${{ matrix.IMPL }} STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} - shell: bash - name: Performance Tests + shell: bash run: | + echo shell: bash, hello world from Performance Tests + echo export ${{ matrix.IMPL }} + echo ./ci.sh perf ${IMPL} export ${{ matrix.IMPL }} ./ci.sh perf ${IMPL} - shell: bash - name: Archive logs and debug output uses: actions/upload-artifact@v4 with: From 85c72fe40077606770d1e6ed22618e14db95865c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 12:59:23 +0800 Subject: [PATCH 059/129] vbs: add an makefile to vbs impl --- impls/vbs/Makefile | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 impls/vbs/Makefile diff --git a/impls/vbs/Makefile b/impls/vbs/Makefile new file mode 100644 index 0000000000..b8722e6d92 --- /dev/null +++ b/impls/vbs/Makefile @@ -0,0 +1,4 @@ +all: + true + +clean: From a85bbef5171d0f11605f197d497f40e86298daf8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 13:38:49 +0800 Subject: [PATCH 060/129] vbs: Merge branch 'master' into cy20lin-fix-windows-runtest --- Makefile.impls | 8 +- impls/make/core.mk | 323 ++++++++++++++++++++++----------- impls/make/env.mk | 42 +++-- impls/make/printer.mk | 36 ++-- impls/make/readline.mk | 15 +- impls/make/step2_eval.mk | 94 ++++------ impls/make/step3_env.mk | 130 ++++++------- impls/make/step4_if_fn_do.mk | 166 ++++++++--------- impls/make/step6_file.mk | 183 +++++++++---------- impls/make/step7_quote.mk | 234 +++++++++++------------- impls/make/step8_macros.mk | 248 +++++++++++-------------- impls/make/step9_try.mk | 279 +++++++++++++--------------- impls/make/stepA_mal.mk | 293 +++++++++++++----------------- impls/make/util.mk | 104 +++++------ impls/python/env.py | 4 + impls/python/reader.py | 23 +-- impls/python/step3_env.py | 31 ++-- impls/python/step4_if_fn_do.py | 39 ++-- impls/python/step5_tco.py | 52 ++---- impls/python/step6_file.py | 58 +++--- impls/python/step7_quote.py | 81 ++++----- impls/python/step8_macros.py | 90 ++++----- impls/python/step9_try.py | 106 +++++------ impls/python/stepA_mal.py | 107 +++++------ process/guide.md | 68 +++---- runtest.py | 216 +++++++++++++++------- 26 files changed, 1451 insertions(+), 1579 deletions(-) diff --git a/Makefile.impls b/Makefile.impls index 19ccdca846..9e4bbdc7d5 100644 --- a/Makefile.impls +++ b/Makefile.impls @@ -26,7 +26,7 @@ python_MODE = python scheme_MODE = chibi # sml (polyml, mlton, mosml) sml_MODE = polyml -# wasmtime wasmer wax node warpy wace_libc direct js wace_fooboot +# wasmtime wasmer lucet wax node warpy wace_libc wasm_MODE = wasmtime @@ -36,14 +36,13 @@ wasm_MODE = wasmtime IMPLS = ada ada.2 awk bash basic bbc-basic c c.2 chuck clojure coffee common-lisp cpp crystal cs d dart \ elisp elixir elm erlang es6 factor fantom fennel forth fsharp go groovy gnu-smalltalk \ - guile haskell haxe hy io janet java java-truffle js jq julia kotlin latex3 livescript logo lua make mal \ + guile haskell haxe hy io janet java java-truffle js jq julia kotlin livescript logo lua make mal \ matlab miniMAL nasm nim objc objpascal ocaml perl perl6 php picolisp pike plpgsql \ plsql powershell prolog ps purs python python.2 r racket rexx rpython ruby ruby.2 rust scala scheme skew sml \ swift swift3 swift4 swift5 tcl ts vala vb vbs vhdl vimscript wasm wren yorick xslt zig step5_EXCLUDES += bash # never completes at 10,000 step5_EXCLUDES += basic # too slow, and limited to ints of 2^16 -step5_EXCLUDES += latex3 # no iteration, limited native stack step5_EXCLUDES += make # no TCO capability (iteration or recursion) step5_EXCLUDES += mal # host impl dependent step5_EXCLUDES += matlab # never completes at 10,000 @@ -146,7 +145,6 @@ js_STEP_TO_PROG = impls/js/$($(1)).js jq_STEP_PROG = impls/jq/$($(1)).jq julia_STEP_TO_PROG = impls/julia/$($(1)).jl kotlin_STEP_TO_PROG = impls/kotlin/$($(1)).jar -latex3_STEP_TO_PROG = impls/latex3/$($(1)).tex livescript_STEP_TO_PROG = impls/livescript/$($(1)).js logo_STEP_TO_PROG = impls/logo/$($(1)).lg lua_STEP_TO_PROG = impls/lua/$($(1)).lua @@ -194,7 +192,7 @@ vb_STEP_TO_PROG = impls/vb/$($(1)).exe vbs_STEP_TO_PROG = impls/vbs/$($(1)).vbs vhdl_STEP_TO_PROG = impls/vhdl/$($(1)) vimscript_STEP_TO_PROG = impls/vimscript/$($(1)).vim -wasm_STEP_TO_PROG = impls/wasm/$($(1)).wasm +wasm_STEP_TO_PROG = impls/wasm/$($(1)).$(if $(filter lucet,$(wasm_MODE)),so,wasm) wren_STEP_TO_PROG = impls/wren/$($(1)).wren yorick_STEP_TO_PROG = impls/yorick/$($(1)).i xslt_STEP_TO_PROG = impls/xslt/$($(1)) diff --git a/impls/make/core.mk b/impls/make/core.mk index 1442f049dd..5e88f7b44f 100644 --- a/impls/make/core.mk +++ b/impls/make/core.mk @@ -13,189 +13,292 @@ include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk +# Errors/Exceptions +throw = $(eval __ERROR := $(1)) + + # General functions -$(encoded_equal) = $(if $(call _equal?,$(firstword $1),$(lastword $1)),$(__true),$(__false)) +# Return the type of the object (or "make" if it's not a object +obj_type = $(call _string,$(call _obj_type,$(1))) + +equal? = $(if $(call _equal?,$(word 1,$(1)),$(word 2,$(1))),$(__true),$(__false)) # Scalar functions -nil? = $(if $(_nil?),$(__true),$(__false)) -true? = $(if $(_true?),$(__true),$(__false)) -false? = $(if $(_false?),$(__true),$(__false)) +nil? = $(if $(call _nil?,$(1)),$(__true),$(__false)) +true? = $(if $(call _true?,$(1)),$(__true),$(__false)) +false? = $(if $(call _false?,$(1)),$(__true),$(__false)) # Symbol functions -symbol = $(call _symbol,$(_string_val)) -symbol? = $(if $(_symbol?),$(__true),$(__false)) +symbol = $(call _symbol,$(call str_decode,$($(1)_value))) +symbol? = $(if $(call _symbol?,$(1)),$(__true),$(__false)) # Keyword functions -keyword = $(if $(_keyword?),$1,$(call _keyword,$(_string_val))) -keyword? = $(if $(_keyword?),$(__true),$(__false)) +keyword = $(if $(_keyword?),$(1),$(call _keyword,$(call str_decode,$($(1)_value)))) +keyword? = $(if $(call _keyword?,$(1)),$(__true),$(__false)) # Number functions -number? = $(if $(_number?),$(__true),$(__false)) - -define < -$(if $(call int_lt,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ - ,$(__true),$(__false)) -endef -define <$(encoded_equal) -$(if $(call int_lte,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ - ,$(__true),$(__false)) -endef -define > -$(if $(call int_gt,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ - ,$(__true),$(__false)) -endef -define >$(encoded_equal) -$(if $(call int_gte,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ - ,$(__true),$(__false)) -endef - -+ = $(call _number,$(call int_add,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) -- = $(call _number,$(call int_sub,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) -* = $(call _number,$(call int_mult,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) -/ = $(call _number,$(call int_div,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) - -time-ms = $(call _number,$(shell date +%s%3N)) +number? = $(if $(call _number?,$(1)),$(__true),$(__false)) + +number_lt = $(if $(call int_lt_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) +number_lte = $(if $(call int_lte_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) +number_gt = $(if $(call int_gt_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) +number_gte = $(if $(call int_gte_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) + +number_plus = $(call _pnumber,$(call int_add_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) +number_subtract = $(call _pnumber,$(call int_sub_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) +number_multiply = $(call _pnumber,$(call int_mult_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) +number_divide = $(call _pnumber,$(call int_div_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) + +time_ms = $(call _number,$(shell echo $$(date +%s%3N))) # String functions -string? = $(if $(_string?),$(__true),$(__false)) +string? = $(if $(call _string?,$(1)),$(if $(call _keyword?,$(1)),$(__false),$(__true)),$(__false)) -pr-str = $(call _string,$(call _pr_str_mult,$1,yes,$(_SP))) -str = $(call _string,$(_pr_str_mult)) -prn = $(__nil)$(call print,$(call _pr_str_mult,$1,yes,$(_SP))) -println = $(__nil)$(call print,$(call _pr_str_mult,$1,,$(_SP))) +pr_str = $(call _string,$(call _pr_str_mult,$(1),yes, )) +str = $(call _string,$(call _pr_str_mult,$(1),,)) +prn = $(info $(call _pr_str_mult,$(1),yes, )) +println = $(info $(subst \n,$(NEWLINE),$(call _pr_str_mult,$(1),, ))) -readline = $(or $(foreach res,$(call READLINE,$(_string_val))\ - ,$(call _string,$(res:ok=)))\ - ,$(__nil)) -read-string = $(call READ_STR,$(_string_val)) -slurp = $(call _string,$(call _read_file,$(_string_val))) +readline= $(foreach res,$(call _string,$(call READLINE,"$(call str_decode,$($(1)_value))")),$(if $(READLINE_EOF),$(eval READLINE_EOF :=)$(__nil),$(res))) +read_str= $(call READ_STR,$(1)) +slurp = $(call _string,$(call _read_file,$(call str_decode,$($(1)_value)))) + +subs = $(strip \ + $(foreach start,$(call int_add,1,$(call int_decode,$($(word 2,$(1))_value))),\ + $(foreach end,$(if $(3),$(call int_decode,$($(3)_value)),$(words $($(word 1,$(1))_value))),\ + $(call _string,$(wordlist $(start),$(end),$($(word 1,$(1))_value)))))) # Function functions -fn? = $(if $(_fn?),$(__true),$(__false)) -macro? = $(if $(_macro?),$(__true),$(__false)) +fn? = $(if $(call _function?,$(1)),$(if $(_macro_$(1)),$(__false),$(__true)),$(__false)) +macro? = $(if $(_macro_$(1)),$(__true),$(__false)) # List functions -list? = $(if $(_list?),$(__true),$(__false)) +list? = $(if $(call _list?,$(1)),$(__true),$(__false)) # Vector functions -vector? = $(if $(_vector?),$(__true),$(__false)) +vector? = $(if $(call _vector?,$(1)),$(__true),$(__false)) -vec = $(if $(_list?)\ - ,$(call vector,$(_seq_vals))$(rem \ -),$(if $(_vector?)\ - ,$1$(rem \ -),$(call _error,vec$(encoded_colon)$(_SP)called$(_SP)on$(_SP)non-sequence))) +vec = $(if $(_list?),$(call _vector,$($1_value)),$(if $(_vector?),$1,$(call _error,vec: called on non-sequence))) # Hash map (associative array) functions -hash-map = $(call _map_new,,$1) -map? = $(if $(_hash_map?),$(__true),$(__false)) +hash_map? = $(if $(call _hash_map?,$(1)),$(__true),$(__false)) # set a key/value in a copy of the hash map -assoc = $(call _map_new,$(firstword $1),$(_rest)) +assoc = $(word 1,\ + $(foreach hm,$(call _clone_obj,$(word 1,$(1))),\ + $(hm) \ + $(call _assoc_seq!,$(hm),$(wordlist 2,$(words $(1)),$(1))))) # unset keys in a copy of the hash map -dissoc = $(call _map_new,$(firstword $1),,$(_rest)) +# TODO: this could be made more efficient by copying only the +# keys that not being removed. +dissoc = $(word 1,\ + $(foreach hm,$(call _clone_obj,$(word 1,$(1))),\ + $(hm) \ + $(call _dissoc_seq!,$(hm),$(wordlist 2,$(words $(1)),$(1))))) + +keys = $(foreach new_list,$(call _list),$(new_list)$(eval $(new_list)_value := $(foreach v,$(call __get_obj_values,$(1)),$(foreach vval,$(word 4,$(subst _, ,$(v))),$(if $(filter $(__keyword)%,$(vval)),$(call _keyword,$(patsubst $(__keyword)%,%,$(vval))),$(call _string,$(vval))))))) -keys = $(call list,$(_keys)) +vals = $(foreach new_list,$(call _list),$(new_list)$(eval $(new_list)_value := $(foreach v,$(call __get_obj_values,$(1)),$($(v))))) -vals = $(call list,$(foreach k,$(_keys),$(call _get,$1,$k))) +# Hash map and vector functions # retrieve the value of a string key object from the hash map, or -# return nil if the key is not found. -get = $(or $(call _get,$(firstword $1),$(lastword $1)),$(__nil)) +# retrive a vector by number object index +get = $(strip \ + $(if $(call _nil?,$(word 1,$(1))),\ + $(__nil),\ + $(if $(call _hash_map?,$(word 1,$(1))),\ + $(call _get,$(word 1,$(1)),$(call str_decode,$($(word 2,$(1))_value))),\ + $(call _get,$(word 1,$(1)),$(call int_decode,$($(word 2,$(1))_value)))))) -contains? = $(if $(call _get,$(firstword $1),$(lastword $1)),$(__true),$(__false)) +contains? = $(if $(call _contains?,$(word 1,$(1)),$(call str_decode,$($(word 2,$(1))_value))),$(__true),$(__false)) # sequence operations -sequential? = $(if $(_sequential?),$(__true),$(__false)) +sequential? = $(if $(call _sequential?,$(1)),$(__true),$(__false)) + +cons = $(word 1,$(foreach new_list,$(call _list),$(new_list) $(eval $(new_list)_value := $(strip $(word 1,$(1)) $(call __get_obj_values,$(word 2,$(1))))))) -# Strip in case seq_vals is empty. -cons = $(call list,$(strip $(firstword $1) $(call _seq_vals,$(lastword $1)))) +concat = $(word 1,$(foreach new_list,$(call _list),$(new_list) $(eval $(new_list)_value := $(strip $(foreach lst,$1,$(call __get_obj_values,$(lst))))))) -# Strip in case foreach introduces a space after an empty argument. -concat = $(call list,$(strip $(foreach l,$1,$(call _seq_vals,$l)))) +nth = $(strip \ + $(if $(call int_lt,$($(word 2,$(1))_value),$(call int_encode,$(call _count,$(word 1,$(1))))),\ + $(word $(call int_add,1,$(call int_decode,$($(word 2,$(1))_value))),$($(word 1,$(1))_value)),\ + $(call _error,nth: index out of range))) -nth = $(or $(word $(call int_add,1,$(call _number_val,$(lastword $1))),\ - $(call _seq_vals,$(firstword $1)))\ - ,$(call _error,nth: index out of range)) +sfirst = $(word 1,$($(1)_value)) -first = $(or $(if $(_sequential?),$(firstword $(_seq_vals))),$(__nil)) +slast = $(word $(words $($(1)_value)),$($(1)_value)) -empty? = $(if $(_seq_vals),$(__false),$(__true)) +empty? = $(if $(_empty?),$(__true),$(__false)) -count = $(call _number,$(words $(if $(_sequential?),$(_seq_vals)))) +count = $(call _number,$(call _count,$(1))) # Creates a new vector/list of the everything after but the first # element -rest = $(call list,$(if $(_sequential?),$(call _rest,$(_seq_vals)))) +srest = $(word 1,$(foreach new_list,$(call _list),\ + $(new_list) \ + $(eval $(new_list)_value := $(wordlist 2,$(words $($(1)_value)),$($(1)_value))))) # Takes a space separated arguments and invokes the first argument # (function object) using the remaining arguments. -# Strip in case wordlist or _seq_vals is empty. -apply = $(call _apply,$(firstword $1),$(strip \ - $(wordlist 2,$(call int_sub,$(words $1),1),$1) \ - $(call _seq_vals,$(lastword $1)))) +sapply = $(call $(word 1,$(1))_value,$(strip \ + $(wordlist 2,$(call int_sub,$(words $(1)),1),$(1)) \ + $($(word $(words $(1)),$(1))_value))) # Map a function object over a list object -map = $(call list,$(foreach e,$(call _seq_vals,$(lastword $1))\ - ,$(call _apply,$(firstword $1),$e))) - -conj = $(foreach seq,$(firstword $1)\ - ,$(call conj_$(call _obj_type,$(seq)),$(call _seq_vals,$(seq)),$(_rest))) -# Strip in case $1 or $2 is empty. -# Also, _reverse introduces blanks. -conj_vector = $(call vector,$(strip $1 $2)) -conj_list = $(call list,$(strip $(call _reverse,$2) $1)) - -seq = $(or $(seq_$(_obj_type))\ - ,$(call _error,seq: called on non-sequence)) -seq_list = $(if $(_seq_vals),$1,$(__nil)) -seq_vector = $(if $(_seq_vals),$(call list,$(_seq_vals)),$(__nil)) -seq_nil = $1 -seq_string = $(if $(_string_val)\ - ,$(call list,$(foreach c,$(call str_encode,$(_string_val))\ - ,$(call _string,$(call str_decode,$c))))$(rem \ - ),$(__nil)) +smap = $(strip\ + $(foreach func,$(word 1,$(1)),\ + $(foreach lst,$(word 2,$(1)),\ + $(foreach type,list,\ + $(foreach new_hcode,$(call __new_obj_hash_code),\ + $(foreach sz,$(words $(call __get_obj_values,$(lst))),\ + $(eval $(__obj_magic)_$(type)_$(new_hcode)_value := $(strip \ + $(foreach val,$(call __get_obj_values,$(lst)),\ + $(call $(func)_value,$(val))))))\ + $(__obj_magic)_$(type)_$(new_hcode)))))) + +conj = $(word 1,$(foreach new_list,$(call __new_obj_like,$(word 1,$(1))),\ + $(new_list) \ + $(eval $(new_list)_value := $(strip $($(word 1,$(1))_value))) \ + $(if $(call _list?,$(new_list)),\ + $(foreach elem,$(wordlist 2,$(words $(1)),$(1)),\ + $(eval $(new_list)_value := $(strip $(elem) $($(new_list)_value)))),\ + $(eval $(new_list)_value := $(strip $($(new_list)_value) $(wordlist 2,$(words $(1)),$(1))))))) + +seq = $(strip\ + $(if $(call _list?,$(1)),\ + $(if $(call _EQ,0,$(call _count,$(1))),$(__nil),$(1)),\ + $(if $(call _vector?,$(1)),\ + $(if $(call _EQ,0,$(call _count,$(1))),\ + $(__nil),\ + $(word 1,$(foreach new_list,$(call _list),\ + $(new_list) \ + $(eval $(new_list)_value := $(strip $($(word 1,$(1))_value)))))),\ + $(if $(call _EQ,string,$(call _obj_type,$(1))),\ + $(if $(call _EQ,0,$(call _count,$(1))),\ + $(__nil),\ + $(word 1,$(foreach new_list,$(call _list),\ + $(new_list) \ + $(eval $(new_list)_value := $(strip \ + $(foreach c,$($(word 1,$(1))_value),\ + $(call _string,$(c)))))))),\ + $(if $(call _nil?,$(1)),\ + $(__nil),\ + $(call _error,seq: called on non-sequence)))))) # Metadata functions -# are implemented in types.mk. +with_meta = $(strip \ + $(foreach new_obj,$(call _clone_obj,$(word 1,$(1))),\ + $(eval $(new_obj)_meta := $(strip $(word 2,$(1))))\ + $(new_obj))) + +meta = $(strip $($(1)_meta)) # Atom functions -atom? = $(if $(_atom?),$(__true),$(__false)) +atom = $(strip \ + $(foreach hcode,$(call __new_obj_hash_code),\ + $(foreach new_atom,$(__obj_magic)_atom_$(hcode),\ + $(new_atom)\ + $(eval $(new_atom)_value := $(1))))) +atom? = $(if $(call _atom?,$(1)),$(__true),$(__false)) + +deref = $($(1)_value) -reset! = $(foreach v,$(lastword $1),$(call _reset,$(firstword $1),$v)$v) +reset! = $(eval $(word 1,$(1))_value := $(word 2,$(1)))$(word 2,$(1)) -swap! = $(foreach a,$(firstword $1)\ - ,$(call reset!,$a $(call _apply,$(word 2,$1),$(call deref,$a) $(_rest2)))) +swap! = $(foreach resp,$(call $(word 2,$(1))_value,$($(word 1,$(1))_value) $(wordlist 3,$(words $(1)),$(1))),\ + $(eval $(word 1,$(1))_value := $(resp))\ + $(resp)) # Namespace of core functions -core_ns := $(encoded_equal) throw nil? true? false? string? symbol \ - symbol? keyword keyword? number? fn? macro? \ - pr-str str prn println readline read-string slurp \ < \ - <$(encoded_equal) > >$(encoded_equal) + - * / time-ms \ - list list? vector vector? hash-map map? assoc dissoc get \ - contains? keys vals \ - sequential? cons concat vec nth first rest empty? count apply map \ - conj seq \ - with-meta meta atom atom? deref reset! swap! +core_ns = type obj_type \ + = equal? \ + throw throw \ + nil? nil? \ + true? true? \ + false? false? \ + string? string? \ + symbol symbol \ + symbol? symbol? \ + keyword keyword \ + keyword? keyword? \ + number? number? \ + fn? fn? \ + macro? macro? \ + \ + pr-str pr_str \ + str str \ + prn prn \ + println println \ + readline readline \ + read-string read_str \ + slurp slurp \ + subs subs \ + < number_lt \ + <= number_lte \ + > number_gt \ + >= number_gte \ + + number_plus \ + - number_subtract \ + * number_multiply \ + / number_divide \ + time-ms time_ms \ + \ + list _list \ + list? list? \ + vector _vector \ + vector? vector? \ + hash-map _hash_map \ + map? hash_map? \ + assoc assoc \ + dissoc dissoc \ + get get \ + contains? contains? \ + keys keys \ + vals vals \ + \ + sequential? sequential? \ + cons cons \ + concat concat \ + vec vec \ + nth nth \ + first sfirst \ + rest srest \ + last slast \ + empty? empty? \ + count count \ + apply sapply \ + map smap \ + \ + conj conj \ + seq seq \ + \ + with-meta with_meta \ + meta meta \ + atom atom \ + atom? atom? \ + deref deref \ + reset! reset! \ + swap! swap! endif diff --git a/impls/make/env.mk b/impls/make/env.mk index 67719d4543..733ac62b56 100644 --- a/impls/make/env.mk +++ b/impls/make/env.mk @@ -14,21 +14,31 @@ include $(_TOP_DIR)types.mk # An ENV environment is a hash-map with an __outer__ reference to an # outer environment - -# Keys are stored as Make variables named $(env)_$(key). The outer -# environment is the content of the variable itself. - -# 1: outer environment, or "" -> new environment -ENV = $(call __new_obj,env,$1) - -# 1:env 2:key -> value or "" -ENV_GET = $(if $1,$(or $($1_$2),$(call ENV_GET,$($1),$2))) - -# 1:env 2:key 3:value -ENV_SET = $(eval $1_$2 := $3) - -# 1:env -> (encoded) keys -env_keys = $(foreach k,$(patsubst $1_%,%,$(filter $1_%,$(.VARIABLES)))\ - ,$(call _symbol_val,$k)) +define BIND_ARGS +$(strip \ + $(word 1,$(1) \ + $(foreach fparam,$(call _nth,$(2),0),\ + $(if $(call _EQ,&,$($(fparam)_value)), + $(call ENV_SET,$(1),$($(call _nth,$(2),1)_value),$(strip \ + $(foreach new_list,$(call _list), + $(word 1,$(new_list) \ + $(foreach val,$(3),$(call _conj!,$(new_list),$(val))))))),\ + $(foreach val,$(word 1,$(3)),\ + $(call ENV_SET,$(1),$($(fparam)_value),$(val))\ + $(foreach left,$(call srest,$(2)),\ + $(if $(call _EQ,0,$(call _count,$(left))),\ + ,\ + $(call BIND_ARGS,$(1),$(left),$(wordlist 2,$(words $(3)),$(3)))))))))) +endef + +# Create a new ENV and optional bind values in it +# $(1): outer environment (set as a key named __outer__) +# $(2): list/vector object of bind forms +# $(3): space separated list of expressions to bind +ENV = $(strip $(foreach new_env,$(call _assoc!,$(call _hash_map),__outer__,$(if $(1),$(1),$(__nil))),$(if $(2),$(call BIND_ARGS,$(new_env),$(2),$(3)),$(new_env)))) + +ENV_GET = $(if $(call _EQ,$(1),$(__nil)),,$(or $(_get),$(call ENV_GET,$(call _get,$(1),__outer__),$(2)))) + +ENV_SET = $(if $(call _assoc!,$(1),$(subst =,$(__equal),$(2)),$(3)),$(1),) endif diff --git a/impls/make/printer.mk b/impls/make/printer.mk index 0187424d7f..adf859cac7 100644 --- a/impls/make/printer.mk +++ b/impls/make/printer.mk @@ -11,45 +11,37 @@ include $(_TOP_DIR)types.mk # return a printable form of the argument, the second parameter is # 'print_readably' which backslashes quotes in string values -_pr_str = $(call $(_obj_type)_pr_str,$1,$2) +_pr_str = $(if $(1),$(foreach ot,$(call _obj_type,$(1)),$(if $(call _EQ,make,$(ot)),$(call _error,_pr_str failed on $(1)),$(call $(ot)_pr_str,$(1),$(2)))),) # Like _pr_str but takes multiple values in first argument, the second # parameter is 'print_readably' which backslashes quotes in string # values, the third parameter is the delimeter to use between each # _pr_str'd value -_pr_str_mult = $(subst $(SPACE),$3,$(foreach f,$1,$(call _pr_str,$f,$2))) +_pr_str_mult = $(call _pr_str,$(word 1,$(1)),$(2))$(if $(word 2,$(1)),$(3)$(call _pr_str_mult,$(wordlist 2,$(words $(1)),$(1)),$(2),$(3)),) # Type specific printing -nil_pr_str := nil -true_pr_str := true -false_pr_str := false +nil_pr_str = nil +true_pr_str = true +false_pr_str = false -number_pr_str = $(_number_val) +number_pr_str = $(call int_decode,$($(1)_value)) -symbol_pr_str = $(_symbol_val) +symbol_pr_str = $($(1)_value) -keyword_pr_str = $(encoded_colon)$(_keyword_val) +keyword_pr_str = $(COLON)$(patsubst $(__keyword)%,%,$(call str_decode,$($(1)_value))) -string_pr_str = $(if $2\ - ,"$(subst $(_NL),$(encoded_slash)n,$(rem \ - )$(subst ",$(encoded_slash)",$(rem \ - )$(subst $(encoded_slash),$(encoded_slash)$(encoded_slash),$(rem \ - )$(_string_val))))"$(rem \ -else \ - ),$(_string_val)) +string_pr_str = $(if $(filter $(__keyword)%,$(call str_decode,$($(1)_value))),$(COLON)$(patsubst $(__keyword)%,%,$(call str_decode,$($(1)_value))),$(if $(2),"$(subst $(NEWLINE),$(ESC_N),$(subst $(DQUOTE),$(ESC_DQUOTE),$(subst $(SLASH),$(SLASH)$(SLASH),$(call str_decode,$($(1)_value)))))",$(call str_decode,$($(1)_value)))) -corefn_pr_str := -function_pr_str := -macro_pr_str := +function_pr_str = -list_pr_str = $(_LP)$(call _pr_str_mult,$(_seq_vals),$2,$(_SP))$(_RP) +list_pr_str = ($(foreach v,$(call __get_obj_values,$(1)),$(call _pr_str,$(v),$(2)))) -vector_pr_str = [$(call _pr_str_mult,$(_seq_vals),$2,$(_SP))] +vector_pr_str = [$(foreach v,$(call __get_obj_values,$(1)),$(call _pr_str,$(v),$(2)))] -map_pr_str = {$(call _pr_str_mult,$(foreach k,$(_keys),$k $(call _get,$1,$k)),$2,$(_SP))} +hash_map_pr_str = {$(foreach v,$(call __get_obj_values,$(1)),$(foreach vval,$(foreach hcode,$(word 3,$(subst _, ,$(1))),$(patsubst $(1)_%,%,$(v:%_value=%))),$(if $(filter $(__keyword)%,$(vval)),$(patsubst $(__keyword)%,$(COLON)%,$(vval)),"$(vval)")) $(call _pr_str,$($(v)),$(2)))} -atom_pr_str = $(_LP)atom$(_SP)$(call _pr_str,$(deref),$2)$(_RP) +atom_pr_str = (atom $(call _pr_str,$($(1)_value),$(2))) endif diff --git a/impls/make/readline.mk b/impls/make/readline.mk index ab4e287134..3d08ab199b 100644 --- a/impls/make/readline.mk +++ b/impls/make/readline.mk @@ -5,22 +5,19 @@ ifndef __mal_readline_included __mal_readline_included := true -_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)util.mk - # Call bash read/readline. Since each call is in a separate shell # instance we need to restore and save after each call in order to # have readline history. +READLINE_EOF := READLINE_HISTORY_FILE := $${HOME}/.mal-history - -# Either empty (if EOF) or an encoded string with the 'ok' suffix. -READLINE = $(call str_encode_nospace,$(shell \ +READLINE = $(eval __readline_temp := $(subst #,\#,$(subst $$,$$$$,$(shell \ history -r $(READLINE_HISTORY_FILE); \ - read -u 0 -r -e -p '$(str_decode_nospace)' line && \ + read -u 0 -r -e -p $(if $(1),$(1),"user> ") line && \ history -s -- "$${line}" && \ - echo "$${line}ok" ; \ + echo "$${line}" || \ + echo "__||EOF||__"; \ history -a $(READLINE_HISTORY_FILE) 2>/dev/null || \ true \ -)) +))))$(if $(filter __||EOF||__,$(__readline_temp)),$(eval READLINE_EOF := yes),$(__readline_temp))$(if $(DEBUG_READLINE),$(warning readline/$(__readline_temp)/)) endif diff --git a/impls/make/step2_eval.mk b/impls/make/step2_eval.mk index 1dd8f231b2..f03d6d73de 100644 --- a/impls/make/step2_eval.mk +++ b/impls/make/step2_eval.mk @@ -2,86 +2,66 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)readline.mk -include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash +INTERACTIVE ?= yes EVAL_DEBUG ?= # READ: read and parse input define READ -$(READ_STR) +$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) endef -# EVAL: evaluate the parameter - -EVAL_nil = $1 -EVAL_true = $1 -EVAL_false = $1 -EVAL_string = $1 -EVAL_number = $1 -EVAL_keyword = $1 - -EVAL_symbol = $(or $(call _get,$2,$1),$(call _error,'$(_symbol_val)' not found)) - -EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) - -# First foreach defines a constant, second one loops on keys. -define EVAL_map -$(foreach obj,$(call _map_new)\ -,$(obj)$(rem $(foreach k,$(_keys)\ - ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) -endef - -define EVAL_list -$(if $(_seq_vals)\ - ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ - ),$1) -endef - -define EVAL_apply -$(foreach f,$(call EVAL,$(firstword $1),$2)\ -,$(if $(__ERROR)\ - ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) +define EVAL_INVOKE +$(if $(__ERROR),,\ + $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1))))\ + $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ + $(call _apply,$(call sfirst,$(el)),$(call srest,$(el))))) endef +# EVAL: evaluate the parameter define EVAL -$(if $(__ERROR)\ -,,$(if $(EVAL_DEBUG),\ - $(call print,EVAL: $(call _pr_str,$1,yes)))$(rem \ -)$(call EVAL_$(_obj_type),$1,$2)) +$(strip $(if $(__ERROR),,\ + $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(if $(call _contains?,$(2),$(key)),\ + $(call _get,$(2),$(key)),\ + $(call _error,'$(key)' not found in REPL_ENV))),\ + $(if $(call _vector?,$(1)),\ + $(call _smap_vec,EVAL,$(1),$(2)),\ + $(if $(call _hash_map?,$(1)),\ + $(foreach new_hmap,$(call __new_obj,hmap),\ + $(foreach v,$(call __get_obj_values,$(1)),\ + $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ + $(eval $(new_hmap)_size := $($(1)_size))\ + $(new_hmap)),\ + $(if $(call _list?,$(1)),\ + $(if $(call _EQ,0,$(call _count,$(1))),\ + $(1),\ + $(strip $(call EVAL_INVOKE,$(1),$(2)))),\ + $(1))))))) endef # PRINT: define PRINT -$(if $(__ERROR)\ - ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ - ),$(call _pr_str,$1,yes)) +$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) endef # REPL: -REPL_ENV := $(call hash-map,$(foreach f,+ - * /\ - ,$(call _symbol,$f) $(call _corefn,$f))) +REPL_ENV := $(call _hash_map) +REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) +REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) -REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) - -# The foreach does nothing when line is empty (EOF). -define REPL -$(foreach line,$(call READLINE,user>$(_SP))\ -,$(eval __ERROR :=)$(rem \ -)$(call print,$(call REP,$(line:ok=)))$(rem \ -)$(call REPL)) -endef +$(call do,$(call _assoc!,$(REPL_ENV),+,number_plus)) +$(call do,$(call _assoc!,$(REPL_ENV),-,number_subtract)) +$(call do,$(call _assoc!,$(REPL_ENV),*,number_multiply)) +$(call do,$(call _assoc!,$(REPL_ENV),/,number_divide)) # repl loop -$(REPL) - -# Do not complain that there is no target. -.PHONY: none -none: - @true +$(if $(strip $(INTERACTIVE)),$(call REPL)) diff --git a/impls/make/step3_env.mk b/impls/make/step3_env.mk index 0adc209b3b..ccd1fbfd20 100644 --- a/impls/make/step3_env.mk +++ b/impls/make/step3_env.mk @@ -2,8 +2,6 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)readline.mk -include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -11,98 +9,84 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash +INTERACTIVE ?= yes +EVAL_DEBUG ?= # READ: read and parse input define READ -$(READ_STR) +$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) endef # EVAL: evaluate the parameter - -EVAL_nil = $1 -EVAL_true = $1 -EVAL_false = $1 -EVAL_string = $1 -EVAL_number = $1 -EVAL_keyword = $1 - -EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) - -EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) - -# First foreach defines a constant, second one loops on keys. -define EVAL_map -$(foreach obj,$(call _map_new)\ -,$(obj)$(rem $(foreach k,$(_keys)\ - ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +define LET +$(strip \ + $(word 1,$(2) \ + $(foreach var,$(call _nth,$(1),0),\ + $(foreach val,$(call _nth,$(1),1),\ + $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ + $(foreach left,$(call srest,$(call srest,$(1))), + $(if $(call _EQ,0,$(call _count,$(left))),\ + ,\ + $(call LET,$(left),$(2)))))))) endef -define EVAL_list -$(if $(_seq_vals)\ - ,$(foreach a0,$(firstword $(_seq_vals))\ - ,$(if $(call _symbol?,$(a0))\ - ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ - ,$(if $(filter undefined,$(flavor $(dispatch)))\ - ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ - ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ - ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ - ),$1) -endef - -define EVAL_apply -$(foreach f,$(call EVAL,$(firstword $1),$2)\ -,$(if $(__ERROR)\ - ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) -endef - -define EVAL_special_def! -$(foreach res,$(call EVAL,$(lastword $1),$2)\ - ,$(if $(__ERROR)\ - ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) -endef - -define EVAL_special_let* -$(foreach let_env,$(call ENV,$2)\ -,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ - ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ -)$(call EVAL,$(lastword $1),$(let_env))) +define EVAL_INVOKE +$(if $(__ERROR),,\ + $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) + $(foreach a0,$(call _nth,$(1),0),\ + $(if $(call _EQ,def!,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach res,$(call EVAL,$(a2),$(2)),\ + $(if $(__ERROR),,\ + $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ + $(if $(call _EQ,let*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ + $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ + $(call _apply,$(call sfirst,$(el)),$(call srest,$(el)))))))) endef define EVAL -$(if $(__ERROR)\ -,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ - ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ -)$(call EVAL_$(_obj_type),$1,$2)) +$(strip $(if $(__ERROR),,\ + $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ + $(info EVAL: $(_pr_str)))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(or $(call ENV_GET,$(2),$(key)),\ + $(call _error,'$(key)' not found)$(__nil))),\ + $(if $(call _vector?,$(1)),\ + $(call _smap_vec,EVAL,$(1),$(2)),\ + $(if $(call _hash_map?,$(1)),\ + $(foreach new_hmap,$(call __new_obj,hmap),\ + $(foreach v,$(call __get_obj_values,$(1)),\ + $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ + $(eval $(new_hmap)_size := $($(1)_size))\ + $(new_hmap)),\ + $(if $(call _list?,$(1)),\ + $(if $(call _EQ,0,$(call _count,$(1))),\ + $(1),\ + $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ + $(1))))))) endef # PRINT: define PRINT -$(if $(__ERROR)\ - ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ - ),$(call _pr_str,$1,yes)) +$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) - -# The foreach does nothing when line is empty (EOF). -define REPL -$(foreach line,$(call READLINE,user>$(_SP))\ -,$(eval __ERROR :=)$(rem \ -)$(call print,$(call REP,$(line:ok=)))$(rem \ -)$(call REPL)) -endef +REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) +REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) # Setup the environment -$(foreach f,+ - * /\ - ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),+,number_plus) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),-,number_subtract) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),*,number_multiply) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),/,number_divide) # repl loop -$(REPL) - -# Do not complain that there is no target. -.PHONY: none -none: - @true +$(if $(strip $(INTERACTIVE)),$(call REPL)) diff --git a/impls/make/step4_if_fn_do.mk b/impls/make/step4_if_fn_do.mk index 6384f63507..529f5e5a5c 100644 --- a/impls/make/step4_if_fn_do.mk +++ b/impls/make/step4_if_fn_do.mk @@ -2,8 +2,6 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)readline.mk -include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -11,120 +9,102 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash +INTERACTIVE ?= yes +EVAL_DEBUG ?= # READ: read and parse input define READ -$(READ_STR) +$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) endef # EVAL: evaluate the parameter - -EVAL_nil = $1 -EVAL_true = $1 -EVAL_false = $1 -EVAL_string = $1 -EVAL_number = $1 -EVAL_keyword = $1 - -EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) - -EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) - -# First foreach defines a constant, second one loops on keys. -define EVAL_map -$(foreach obj,$(call _map_new)\ -,$(obj)$(rem $(foreach k,$(_keys)\ - ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) -endef - -define EVAL_list -$(if $(_seq_vals)\ - ,$(foreach a0,$(firstword $(_seq_vals))\ - ,$(if $(call _symbol?,$(a0))\ - ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ - ,$(if $(filter undefined,$(flavor $(dispatch)))\ - ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ - ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ - ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ - ),$1) -endef - -define EVAL_apply -$(foreach f,$(call EVAL,$(firstword $1),$2)\ -,$(if $(__ERROR)\ - ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) -endef - -define EVAL_special_def! -$(foreach res,$(call EVAL,$(lastword $1),$2)\ - ,$(if $(__ERROR)\ - ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +define LET +$(strip \ + $(word 1,$(2) \ + $(foreach var,$(call _nth,$(1),0),\ + $(foreach val,$(call _nth,$(1),1),\ + $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ + $(foreach left,$(call srest,$(call srest,$(1))), + $(if $(call _EQ,0,$(call _count,$(left))),\ + ,\ + $(call LET,$(left),$(2)))))))) endef -define EVAL_special_let* -$(foreach let_env,$(call ENV,$2)\ -,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ - ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ -)$(call EVAL,$(lastword $1),$(let_env))) +define EVAL_INVOKE +$(if $(__ERROR),,\ + $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) + $(foreach a0,$(call _nth,$(1),0),\ + $(if $(call _EQ,def!,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach res,$(call EVAL,$(a2),$(2)),\ + $(if $(__ERROR),,\ + $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ + $(if $(call _EQ,let*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ + $(if $(call _EQ,do,$($(a0)_value)),\ + $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ + $(if $(call _EQ,if,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach cond,$(call EVAL,$(a1),$(2)),\ + $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ + $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ + $(call EVAL,$(a2),$(2)))))),\ + $(if $(call _EQ,fn*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ + $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ + $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ + $(foreach f,$(call sfirst,$(el)),\ + $(foreach args,$(call srest,$(el)),\ + $(call apply,$(f),$(args)))))))))))) endef -EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) - -define EVAL_special_if -$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ - ,$(call EVAL,$(word 2,$1),$2)$(rem \ -),$(if $(word 3,$1)\ - ,$(call EVAL,$(lastword $1),$2)$(rem \ -),$(__nil))) -endef - -EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) - define EVAL -$(if $(__ERROR)\ -,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ - ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ -)$(call EVAL_$(_obj_type),$1,$2)) +$(strip $(if $(__ERROR),,\ + $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ + $(info EVAL: $(_pr_str)))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(or $(call ENV_GET,$(2),$(key)),\ + $(call _error,'$(key)' not found)$(__nil))),\ + $(if $(call _vector?,$(1)),\ + $(call _smap_vec,EVAL,$(1),$(2)),\ + $(if $(call _hash_map?,$(1)),\ + $(foreach new_hmap,$(call __new_obj,hmap),\ + $(foreach v,$(call __get_obj_values,$(1)),\ + $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ + $(eval $(new_hmap)_size := $($(1)_size))\ + $(new_hmap)),\ + $(if $(call _list?,$(1)),\ + $(if $(call _EQ,0,$(call _count,$(1))),\ + $(1),\ + $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ + $(1))))))) endef # PRINT: define PRINT -$(if $(__ERROR)\ - ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ - ),$(call _pr_str,$1,yes)) +$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) - -# The foreach does nothing when line is empty (EOF). -define REPL -$(foreach line,$(call READLINE,user>$(_SP))\ -,$(eval __ERROR :=)$(rem \ -)$(call print,$(call REP,$(line:ok=)))$(rem \ -)$(call REPL)) -endef - -# Read and evaluate for side effects but ignore the result. -define RE -$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ -)$(if $(__ERROR)\ - ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) -endef +REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) +REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) # core.mk: defined using Make -$(foreach f,$(core_ns)\ - ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) +_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) +_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) +$(call _import_core,$(core_ns)) # core.mal: defined in terms of the language itself -$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) # repl loop -$(REPL) - -# Do not complain that there is no target. -.PHONY: none -none: - @true +$(if $(strip $(INTERACTIVE)),$(call REPL)) diff --git a/impls/make/step6_file.mk b/impls/make/step6_file.mk index 265d25f76f..6bdad802ce 100644 --- a/impls/make/step6_file.mk +++ b/impls/make/step6_file.mk @@ -2,8 +2,6 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)readline.mk -include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -11,132 +9,117 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash +INTERACTIVE ?= yes +EVAL_DEBUG ?= # READ: read and parse input define READ -$(READ_STR) +$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) endef # EVAL: evaluate the parameter - -EVAL_nil = $1 -EVAL_true = $1 -EVAL_false = $1 -EVAL_string = $1 -EVAL_number = $1 -EVAL_keyword = $1 - -EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) - -EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) - -# First foreach defines a constant, second one loops on keys. -define EVAL_map -$(foreach obj,$(call _map_new)\ -,$(obj)$(rem $(foreach k,$(_keys)\ - ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) -endef - -define EVAL_list -$(if $(_seq_vals)\ - ,$(foreach a0,$(firstword $(_seq_vals))\ - ,$(if $(call _symbol?,$(a0))\ - ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ - ,$(if $(filter undefined,$(flavor $(dispatch)))\ - ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ - ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ - ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ - ),$1) +define LET +$(strip \ + $(word 1,$(2) \ + $(foreach var,$(call _nth,$(1),0),\ + $(foreach val,$(call _nth,$(1),1),\ + $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ + $(foreach left,$(call srest,$(call srest,$(1))), + $(if $(call _EQ,0,$(call _count,$(left))),\ + ,\ + $(call LET,$(left),$(2)))))))) endef -define EVAL_apply -$(foreach f,$(call EVAL,$(firstword $1),$2)\ -,$(if $(__ERROR)\ - ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) +define EVAL_INVOKE +$(if $(__ERROR),,\ + $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) + $(foreach a0,$(call _nth,$(1),0),\ + $(if $(call _EQ,def!,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach res,$(call EVAL,$(a2),$(2)),\ + $(if $(__ERROR),,\ + $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ + $(if $(call _EQ,let*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ + $(if $(call _EQ,do,$($(a0)_value)),\ + $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ + $(if $(call _EQ,if,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach cond,$(call EVAL,$(a1),$(2)),\ + $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ + $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ + $(call EVAL,$(a2),$(2)))))),\ + $(if $(call _EQ,fn*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ + $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ + $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ + $(foreach f,$(call sfirst,$(el)),\ + $(foreach args,$(call srest,$(el)),\ + $(call apply,$(f),$(args)))))))))))) endef -define EVAL_special_def! -$(foreach res,$(call EVAL,$(lastword $1),$2)\ - ,$(if $(__ERROR)\ - ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) -endef - -define EVAL_special_let* -$(foreach let_env,$(call ENV,$2)\ -,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ - ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ -)$(call EVAL,$(lastword $1),$(let_env))) -endef - -EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) - -define EVAL_special_if -$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ - ,$(call EVAL,$(word 2,$1),$2)$(rem \ -),$(if $(word 3,$1)\ - ,$(call EVAL,$(lastword $1),$2)$(rem \ -),$(__nil))) -endef - -EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) - define EVAL -$(if $(__ERROR)\ -,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ - ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ -)$(call EVAL_$(_obj_type),$1,$2)) +$(strip $(if $(__ERROR),,\ + $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ + $(info EVAL: $(_pr_str)))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(or $(call ENV_GET,$(2),$(key)),\ + $(call _error,'$(key)' not found)$(__nil))),\ + $(if $(call _vector?,$(1)),\ + $(call _smap_vec,EVAL,$(1),$(2)),\ + $(if $(call _hash_map?,$(1)),\ + $(foreach new_hmap,$(call __new_obj,hmap),\ + $(foreach v,$(call __get_obj_values,$(1)),\ + $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ + $(eval $(new_hmap)_size := $($(1)_size))\ + $(new_hmap)),\ + $(if $(call _list?,$(1)),\ + $(if $(call _EQ,0,$(call _count,$(1))),\ + $(1),\ + $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ + $(1))))))) endef # PRINT: define PRINT -$(if $(__ERROR)\ - ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ - ),$(call _pr_str,$1,yes)) +$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) - -# The foreach does nothing when line is empty (EOF). -define REPL -$(foreach line,$(call READLINE,user>$(_SP))\ -,$(eval __ERROR :=)$(rem \ -)$(call print,$(call REP,$(line:ok=)))$(rem \ -)$(call REPL)) -endef - -# Read and evaluate for side effects but ignore the result. -define RE -$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ -)$(if $(__ERROR)\ - ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) -endef +REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) +REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) # core.mk: defined using Make -$(foreach f,$(core_ns)\ - ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) - -core_eval = $(call EVAL,$1,$(REPL_ENV)) -$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) - -$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ - $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) +_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) +_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) +$(call _import_core,$(core_ns)) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) +_argv := $(call _list) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) # core.mal: defined in terms of the language itself -$(call RE, (def! not (fn* (a) (if a false true))) ) -$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) +$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) +$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) )) -ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line -$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) -else +$(if $(MAKECMDGOALS),\ + $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ + $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ + $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ + $(eval INTERACTIVE :=),) + # repl loop -$(REPL) -endif +$(if $(strip $(INTERACTIVE)),$(call REPL)) -# Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true diff --git a/impls/make/step7_quote.mk b/impls/make/step7_quote.mk index 68665fb325..a239e5cb69 100644 --- a/impls/make/step7_quote.mk +++ b/impls/make/step7_quote.mk @@ -2,8 +2,6 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)readline.mk -include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -11,168 +9,140 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash +INTERACTIVE ?= yes +EVAL_DEBUG ?= # READ: read and parse input define READ -$(READ_STR) +$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) endef # EVAL: evaluate the parameter -# If $1 is empty, `foreach` does no iteration at all. -starts_with? = $(foreach f,$(firstword $1)\ - ,$(and $(call _symbol?,$f),\ - $(filter $2,$(call _symbol_val,$f)))) - # elt, accumulator list -> new accumulator list -QQ_LOOP = $(if $(and $(_list?),\ - $(call starts_with?,$(_seq_vals),splice-unquote))\ - ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ - ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) +QQ_LOOP = $(call _list,\ + $(if $(and $(_list?),$(call _EQ,splice-unquote,$($(sfirst)_value))),\ + $(call _symbol,concat) $(call _nth,$1,1),\ + $(call _symbol,cons) $(QUASIQUOTE))\ + $2) # list or vector source -> right folded list -QQ_FOLD = $(if $1\ - ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ - ),$(call list)) - -QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) -QUASIQUOTE_nil = $1 -QUASIQUOTE_true = $1 -QUASIQUOTE_false = $1 -QUASIQUOTE_string = $1 -QUASIQUOTE_number = $1 -QUASIQUOTE_keyword = $1 -QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) -QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) - -QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) - -QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ - ,$(lastword $(_seq_vals))$(rem \ - ),$(call QQ_FOLD,$(_seq_vals))) - -EVAL_special_quote = $1 - -EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) - -EVAL_nil = $1 -EVAL_true = $1 -EVAL_false = $1 -EVAL_string = $1 -EVAL_number = $1 -EVAL_keyword = $1 - -EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) - -EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) - -# First foreach defines a constant, second one loops on keys. -define EVAL_map -$(foreach obj,$(call _map_new)\ -,$(obj)$(rem $(foreach k,$(_keys)\ - ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) -endef - -define EVAL_list -$(if $(_seq_vals)\ - ,$(foreach a0,$(firstword $(_seq_vals))\ - ,$(if $(call _symbol?,$(a0))\ - ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ - ,$(if $(filter undefined,$(flavor $(dispatch)))\ - ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ - ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ - ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ - ),$1) -endef - -define EVAL_apply -$(foreach f,$(call EVAL,$(firstword $1),$2)\ -,$(if $(__ERROR)\ - ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) +QQ_FOLD = $(if $(_empty?),$(call _list,),$(call QQ_LOOP,$(sfirst),$(call QQ_FOLD,$(srest)))) + +QUASIQUOTE = $(strip \ + $(if $(_list?), $(if $(call _EQ,unquote,$($(sfirst)_value)),\ + $(call _nth,$1,1),\ + $(QQ_FOLD)),\ + $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ + $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ + $1)))) + +define LET +$(strip \ + $(word 1,$(2) \ + $(foreach var,$(call _nth,$(1),0),\ + $(foreach val,$(call _nth,$(1),1),\ + $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ + $(foreach left,$(call srest,$(call srest,$(1))), + $(if $(call _EQ,0,$(call _count,$(left))),\ + ,\ + $(call LET,$(left),$(2)))))))) endef -define EVAL_special_def! -$(foreach res,$(call EVAL,$(lastword $1),$2)\ - ,$(if $(__ERROR)\ - ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +define EVAL_INVOKE +$(if $(__ERROR),,\ + $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) + $(foreach a0,$(call _nth,$(1),0),\ + $(if $(call _EQ,def!,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach res,$(call EVAL,$(a2),$(2)),\ + $(if $(__ERROR),,\ + $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ + $(if $(call _EQ,let*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ + $(if $(call _EQ,quote,$($(a0)_value)),\ + $(call _nth,$(1),1),\ + $(if $(call _EQ,quasiquote,$($(a0)_value)),\ + $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ + $(if $(call _EQ,do,$($(a0)_value)),\ + $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ + $(if $(call _EQ,if,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach cond,$(call EVAL,$(a1),$(2)),\ + $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ + $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ + $(call EVAL,$(a2),$(2)))))),\ + $(if $(call _EQ,fn*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ + $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ + $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ + $(foreach f,$(call sfirst,$(el)),\ + $(foreach args,$(call srest,$(el)),\ + $(call apply,$(f),$(args)))))))))))))) endef -define EVAL_special_let* -$(foreach let_env,$(call ENV,$2)\ -,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ - ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ -)$(call EVAL,$(lastword $1),$(let_env))) -endef - -EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) - -define EVAL_special_if -$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ - ,$(call EVAL,$(word 2,$1),$2)$(rem \ -),$(if $(word 3,$1)\ - ,$(call EVAL,$(lastword $1),$2)$(rem \ -),$(__nil))) -endef - -EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) - define EVAL -$(if $(__ERROR)\ -,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ - ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ -)$(call EVAL_$(_obj_type),$1,$2)) +$(strip $(if $(__ERROR),,\ + $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ + $(info EVAL: $(_pr_str)))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(or $(call ENV_GET,$(2),$(key)),\ + $(call _error,'$(key)' not found)$(__nil))),\ + $(if $(call _vector?,$(1)),\ + $(call _smap_vec,EVAL,$(1),$(2)),\ + $(if $(call _hash_map?,$(1)),\ + $(foreach new_hmap,$(call __new_obj,hmap),\ + $(foreach v,$(call __get_obj_values,$(1)),\ + $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ + $(eval $(new_hmap)_size := $($(1)_size))\ + $(new_hmap)),\ + $(if $(call _list?,$(1)),\ + $(if $(call _EQ,0,$(call _count,$(1))),\ + $(1),\ + $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ + $(1))))))) endef # PRINT: define PRINT -$(if $(__ERROR)\ - ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ - ),$(call _pr_str,$1,yes)) +$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) - -# The foreach does nothing when line is empty (EOF). -define REPL -$(foreach line,$(call READLINE,user>$(_SP))\ -,$(eval __ERROR :=)$(rem \ -)$(call print,$(call REP,$(line:ok=)))$(rem \ -)$(call REPL)) -endef - -# Read and evaluate for side effects but ignore the result. -define RE -$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ -)$(if $(__ERROR)\ - ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) -endef +REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) +REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) # core.mk: defined using Make -$(foreach f,$(core_ns)\ - ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) - -core_eval = $(call EVAL,$1,$(REPL_ENV)) -$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) - -$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ - $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) +_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) +_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) +$(call _import_core,$(core_ns)) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) +_argv := $(call _list) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) # core.mal: defined in terms of the language itself -$(call RE, (def! not (fn* (a) (if a false true))) ) -$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) +$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) +$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) )) -ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line -$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) -else +$(if $(MAKECMDGOALS),\ + $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ + $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ + $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ + $(eval INTERACTIVE :=),) + # repl loop -$(REPL) -endif +$(if $(strip $(INTERACTIVE)),$(call REPL)) -# Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true diff --git a/impls/make/step8_macros.mk b/impls/make/step8_macros.mk index 7815c9d80f..07f17b7000 100644 --- a/impls/make/step8_macros.mk +++ b/impls/make/step8_macros.mk @@ -2,8 +2,6 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)readline.mk -include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -11,176 +9,146 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash +INTERACTIVE ?= yes +EVAL_DEBUG ?= # READ: read and parse input define READ -$(READ_STR) +$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) endef # EVAL: evaluate the parameter -# If $1 is empty, `foreach` does no iteration at all. -starts_with? = $(foreach f,$(firstword $1)\ - ,$(and $(call _symbol?,$f),\ - $(filter $2,$(call _symbol_val,$f)))) - # elt, accumulator list -> new accumulator list -QQ_LOOP = $(if $(and $(_list?),\ - $(call starts_with?,$(_seq_vals),splice-unquote))\ - ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ - ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) +QQ_LOOP = $(call _list,\ + $(if $(and $(_list?),$(call _EQ,splice-unquote,$($(sfirst)_value))),\ + $(call _symbol,concat) $(call _nth,$1,1),\ + $(call _symbol,cons) $(QUASIQUOTE))\ + $2) # list or vector source -> right folded list -QQ_FOLD = $(if $1\ - ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ - ),$(call list)) - -QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) -QUASIQUOTE_nil = $1 -QUASIQUOTE_true = $1 -QUASIQUOTE_false = $1 -QUASIQUOTE_string = $1 -QUASIQUOTE_number = $1 -QUASIQUOTE_keyword = $1 -QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) -QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) - -QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) - -QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ - ,$(lastword $(_seq_vals))$(rem \ - ),$(call QQ_FOLD,$(_seq_vals))) - -EVAL_special_quote = $1 - -EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) - -EVAL_nil = $1 -EVAL_true = $1 -EVAL_false = $1 -EVAL_string = $1 -EVAL_number = $1 -EVAL_keyword = $1 - -EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) - -EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) - -# First foreach defines a constant, second one loops on keys. -define EVAL_map -$(foreach obj,$(call _map_new)\ -,$(obj)$(rem $(foreach k,$(_keys)\ - ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) -endef - -define EVAL_list -$(if $(_seq_vals)\ - ,$(foreach a0,$(firstword $(_seq_vals))\ - ,$(if $(call _symbol?,$(a0))\ - ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ - ,$(if $(filter undefined,$(flavor $(dispatch)))\ - ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ - ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ - ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ - ),$1) -endef - -define EVAL_apply -$(foreach f,$(call EVAL,$(firstword $1),$2)\ -,$(if $(__ERROR)\ - ,,$(if $(call _macro?,$f)\ - ,$(call EVAL,$(call _apply,$f,$(_rest)),$2)$(rem \ - ),$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2)))))) +QQ_FOLD = $(if $(_empty?),$(call _list,),$(call QQ_LOOP,$(sfirst),$(call QQ_FOLD,$(srest)))) + +QUASIQUOTE = $(strip \ + $(if $(_list?), $(if $(call _EQ,unquote,$($(sfirst)_value)),\ + $(call _nth,$1,1),\ + $(QQ_FOLD)),\ + $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ + $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ + $1)))) +define LET +$(strip \ + $(word 1,$(2) \ + $(foreach var,$(call _nth,$(1),0),\ + $(foreach val,$(call _nth,$(1),1),\ + $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ + $(foreach left,$(call srest,$(call srest,$(1))), + $(if $(call _EQ,0,$(call _count,$(left))),\ + ,\ + $(call LET,$(left),$(2)))))))) endef -define EVAL_special_defmacro! -$(foreach res,$(call _as_macro,$(call EVAL,$(lastword $1),$2))\ - ,$(res)$(call ENV_SET,$2,$(firstword $1),$(res))) +define EVAL_INVOKE +$(if $(__ERROR),,\ + $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) + $(foreach a0,$(call _nth,$(1),0),\ + $(if $(call _EQ,def!,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach res,$(call EVAL,$(a2),$(2)),\ + $(if $(__ERROR),,\ + $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ + $(if $(call _EQ,let*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ + $(if $(call _EQ,quote,$($(a0)_value)),\ + $(call _nth,$(1),1),\ + $(if $(call _EQ,quasiquote,$($(a0)_value)),\ + $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ + $(if $(call _EQ,defmacro!,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach res,$(call _clone_obj,$(call EVAL,$(a2),$(2))),\ + $(eval _macro_$(res) = true)\ + $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ + $(if $(call _EQ,do,$($(a0)_value)),\ + $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ + $(if $(call _EQ,if,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach cond,$(call EVAL,$(a1),$(2)),\ + $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ + $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ + $(call EVAL,$(a2),$(2)))))),\ + $(if $(call _EQ,fn*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ + $(foreach f,$(call EVAL,$(a0),$(2)),\ + $(foreach args,$(call srest,$(1)),\ + $(if $(_macro_$(f)),\ + $(call EVAL,$(call apply,$(f),$(args)),$(2)),\ + $(call apply,$(f),$(call _smap,EVAL,$(args),$(2)))))))))))))))) endef -define EVAL_special_def! -$(foreach res,$(call EVAL,$(lastword $1),$2)\ - ,$(if $(__ERROR)\ - ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) -endef - -define EVAL_special_let* -$(foreach let_env,$(call ENV,$2)\ -,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ - ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ -)$(call EVAL,$(lastword $1),$(let_env))) -endef - -EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) - -define EVAL_special_if -$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ - ,$(call EVAL,$(word 2,$1),$2)$(rem \ -),$(if $(word 3,$1)\ - ,$(call EVAL,$(lastword $1),$2)$(rem \ -),$(__nil))) -endef - -EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) - define EVAL -$(if $(__ERROR)\ -,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ - ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ -)$(call EVAL_$(_obj_type),$1,$2)) +$(strip $(if $(__ERROR),,\ + $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ + $(info EVAL: $(_pr_str)))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(or $(call ENV_GET,$(2),$(key)),\ + $(call _error,'$(key)' not found)$(__nil))),\ + $(if $(call _vector?,$(1)),\ + $(call _smap_vec,EVAL,$(1),$(2)),\ + $(if $(call _hash_map?,$(1)),\ + $(foreach new_hmap,$(call __new_obj,hmap),\ + $(foreach v,$(call __get_obj_values,$(1)),\ + $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ + $(eval $(new_hmap)_size := $($(1)_size))\ + $(new_hmap)),\ + $(if $(call _list?,$(1)),\ + $(if $(call _EQ,0,$(call _count,$(1))),\ + $(1),\ + $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ + $(1))))))) endef # PRINT: define PRINT -$(if $(__ERROR)\ - ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ - ),$(call _pr_str,$1,yes)) +$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) - -# The foreach does nothing when line is empty (EOF). -define REPL -$(foreach line,$(call READLINE,user>$(_SP))\ -,$(eval __ERROR :=)$(rem \ -)$(call print,$(call REP,$(line:ok=)))$(rem \ -)$(call REPL)) -endef - -# Read and evaluate for side effects but ignore the result. -define RE -$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ -)$(if $(__ERROR)\ - ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) -endef +REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) +REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) # core.mk: defined using Make -$(foreach f,$(core_ns)\ - ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) - -core_eval = $(call EVAL,$1,$(REPL_ENV)) -$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) - -$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ - $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) +_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) +_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) +$(call _import_core,$(core_ns)) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) +_argv := $(call _list) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) # core.mal: defined in terms of the language itself -$(call RE, (def! not (fn* (a) (if a false true))) ) -$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) -$(call RE, (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))))))) ) +$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) +$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) )) +$(call do,$(call 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))))))) )) -ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line -$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) -else +$(if $(MAKECMDGOALS),\ + $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ + $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ + $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ + $(eval INTERACTIVE :=),) + # repl loop -$(REPL) -endif +$(if $(strip $(INTERACTIVE)),$(call REPL)) -# Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true diff --git a/impls/make/step9_try.mk b/impls/make/step9_try.mk index 4d80fd9810..7a9b8653b1 100644 --- a/impls/make/step9_try.mk +++ b/impls/make/step9_try.mk @@ -2,8 +2,6 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)readline.mk -include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -11,192 +9,161 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash +INTERACTIVE ?= yes +EVAL_DEBUG ?= # READ: read and parse input define READ -$(READ_STR) +$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) endef # EVAL: evaluate the parameter -# If $1 is empty, `foreach` does no iteration at all. -starts_with? = $(foreach f,$(firstword $1)\ - ,$(and $(call _symbol?,$f),\ - $(filter $2,$(call _symbol_val,$f)))) - # elt, accumulator list -> new accumulator list -QQ_LOOP = $(if $(and $(_list?),\ - $(call starts_with?,$(_seq_vals),splice-unquote))\ - ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ - ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) +QQ_LOOP = $(call _list,\ + $(if $(and $(_list?),$(call _EQ,splice-unquote,$($(sfirst)_value))),\ + $(call _symbol,concat) $(call _nth,$1,1),\ + $(call _symbol,cons) $(QUASIQUOTE))\ + $2) # list or vector source -> right folded list -QQ_FOLD = $(if $1\ - ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ - ),$(call list)) - -QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) -QUASIQUOTE_nil = $1 -QUASIQUOTE_true = $1 -QUASIQUOTE_false = $1 -QUASIQUOTE_string = $1 -QUASIQUOTE_number = $1 -QUASIQUOTE_keyword = $1 -QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) -QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) - -QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) - -QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ - ,$(lastword $(_seq_vals))$(rem \ - ),$(call QQ_FOLD,$(_seq_vals))) - -EVAL_special_quote = $1 - -EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) - -EVAL_nil = $1 -EVAL_true = $1 -EVAL_false = $1 -EVAL_string = $1 -EVAL_number = $1 -EVAL_keyword = $1 - -EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) - -EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) - -# First foreach defines a constant, second one loops on keys. -define EVAL_map -$(foreach obj,$(call _map_new)\ -,$(obj)$(rem $(foreach k,$(_keys)\ - ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) -endef - -define EVAL_list -$(if $(_seq_vals)\ - ,$(foreach a0,$(firstword $(_seq_vals))\ - ,$(if $(call _symbol?,$(a0))\ - ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ - ,$(if $(filter undefined,$(flavor $(dispatch)))\ - ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ - ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ - ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ - ),$1) -endef - -define EVAL_apply -$(foreach f,$(call EVAL,$(firstword $1),$2)\ -,$(if $(__ERROR)\ - ,,$(if $(call _macro?,$f)\ - ,$(call EVAL,$(call _apply,$f,$(_rest)),$2)$(rem \ - ),$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2)))))) -endef - -define EVAL_special_defmacro! -$(foreach res,$(call _as_macro,$(call EVAL,$(lastword $1),$2))\ - ,$(res)$(call ENV_SET,$2,$(firstword $1),$(res))) -endef - -define EVAL_special_def! -$(foreach res,$(call EVAL,$(lastword $1),$2)\ - ,$(if $(__ERROR)\ - ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) -endef - -define EVAL_special_let* -$(foreach let_env,$(call ENV,$2)\ -,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ - ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ -)$(call EVAL,$(lastword $1),$(let_env))) +QQ_FOLD = $(if $(_empty?),$(call _list,),$(call QQ_LOOP,$(sfirst),$(call QQ_FOLD,$(srest)))) + +QUASIQUOTE = $(strip \ + $(if $(_list?), $(if $(call _EQ,unquote,$($(sfirst)_value)),\ + $(call _nth,$1,1),\ + $(QQ_FOLD)),\ + $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ + $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ + $1)))) +define LET +$(strip \ + $(word 1,$(2) \ + $(foreach var,$(call _nth,$(1),0),\ + $(foreach val,$(call _nth,$(1),1),\ + $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ + $(foreach left,$(call srest,$(call srest,$(1))), + $(if $(call _EQ,0,$(call _count,$(left))),\ + ,\ + $(call LET,$(left),$(2)))))))) endef -EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) - -define EVAL_special_if -$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ - ,$(call EVAL,$(word 2,$1),$2)$(rem \ -),$(if $(word 3,$1)\ - ,$(call EVAL,$(lastword $1),$2)$(rem \ -),$(__nil))) -endef - -EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) - -# EVAL may fail and return nothing, so the first foreach may execute -# nothing, so we need to duplicate the test for error. -# The second foreach deliberately does nothing when there is no -# catch_list. -define EVAL_special_try* -$(foreach res,$(call EVAL,$(firstword $1),$2)\ - ,$(if $(__ERROR)\ - ,,$(res)))$(rem \ -)$(if $(__ERROR)\ - ,$(foreach catch_list,$(word 2,$1)\ - ,$(foreach env,$(call ENV,$2)\ - ,$(call ENV_SET,$(env),$(word 2,$(call _seq_vals,$(catch_list))),$(__ERROR))$(rem \ - )$(eval __ERROR :=)$(rem \ - )$(call EVAL,$(lastword $(call _seq_vals,$(catch_list))),$(env))))) +define EVAL_INVOKE +$(if $(__ERROR),,\ + $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) + $(foreach a0,$(call _nth,$(1),0),\ + $(if $(call _EQ,def!,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach res,$(call EVAL,$(a2),$(2)),\ + $(if $(__ERROR),,\ + $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ + $(if $(call _EQ,let*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ + $(if $(call _EQ,quote,$($(a0)_value)),\ + $(call _nth,$(1),1),\ + $(if $(call _EQ,quasiquote,$($(a0)_value)),\ + $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ + $(if $(call _EQ,defmacro!,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach res,$(call _clone_obj,$(call EVAL,$(a2),$(2))),\ + $(eval _macro_$(res) = true)\ + $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ + $(if $(call _EQ,try*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach res,$(call EVAL,$(a1),$(2)),\ + $(if $(__ERROR),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach a20,$(call _nth,$(a2),0),\ + $(if $(call _EQ,catch*,$($(a20)_value)),\ + $(foreach a21,$(call _nth,$(a2),1),\ + $(foreach a22,$(call _nth,$(a2),2),\ + $(foreach binds,$(call _list,$(a21)),\ + $(foreach catch_env,$(call ENV,$(2),$(binds),$(__ERROR)),\ + $(eval __ERROR :=)\ + $(call EVAL,$(a22),$(catch_env)))))),\ + $(res)))),\ + $(res)))),\ + $(if $(call _EQ,do,$($(a0)_value)),\ + $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ + $(if $(call _EQ,if,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach cond,$(call EVAL,$(a1),$(2)),\ + $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ + $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ + $(call EVAL,$(a2),$(2)))))),\ + $(if $(call _EQ,fn*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ + $(foreach f,$(call EVAL,$(a0),$(2)),\ + $(foreach args,$(call srest,$(1)),\ + $(if $(_macro_$(f)),\ + $(call EVAL,$(call apply,$(f),$(args)),$(2)),\ + $(call apply,$(f),$(call _smap,EVAL,$(args),$(2))))))))))))))))) endef define EVAL -$(if $(__ERROR)\ -,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ - ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ -)$(call EVAL_$(_obj_type),$1,$2)) +$(strip $(if $(__ERROR),,\ + $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ + $(info EVAL: $(_pr_str)))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(or $(call ENV_GET,$(2),$(key)),\ + $(call _error,'$(key)' not found)$(__nil))),\ + $(if $(call _vector?,$(1)),\ + $(call _smap_vec,EVAL,$(1),$(2)),\ + $(if $(call _hash_map?,$(1)),\ + $(foreach new_hmap,$(call __new_obj,hmap),\ + $(foreach v,$(call __get_obj_values,$(1)),\ + $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ + $(eval $(new_hmap)_size := $($(1)_size))\ + $(new_hmap)),\ + $(if $(call _list?,$(1)),\ + $(if $(call _EQ,0,$(call _count,$(1))),\ + $(1),\ + $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ + $(1))))))) endef # PRINT: define PRINT -$(if $(__ERROR)\ - ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ - ),$(call _pr_str,$1,yes)) +$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) - -# The foreach does nothing when line is empty (EOF). -define REPL -$(foreach line,$(call READLINE,user>$(_SP))\ -,$(eval __ERROR :=)$(rem \ -)$(call print,$(call REP,$(line:ok=)))$(rem \ -)$(call REPL)) -endef - -# Read and evaluate for side effects but ignore the result. -define RE -$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ -)$(if $(__ERROR)\ - ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) -endef +REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) +REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) # core.mk: defined using Make -$(foreach f,$(core_ns)\ - ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) - -core_eval = $(call EVAL,$1,$(REPL_ENV)) -$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) - -$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ - $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) +_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) +_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) +$(call _import_core,$(core_ns)) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) +_argv := $(call _list) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) # core.mal: defined in terms of the language itself -$(call RE, (def! not (fn* (a) (if a false true))) ) -$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) -$(call RE, (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))))))) ) +$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) +$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) )) +$(call do,$(call 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))))))) )) -ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line -$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) -else +$(if $(MAKECMDGOALS),\ + $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ + $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ + $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ + $(eval INTERACTIVE :=),) + # repl loop -$(REPL) -endif +$(if $(strip $(INTERACTIVE)),$(call REPL)) -# Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true diff --git a/impls/make/stepA_mal.mk b/impls/make/stepA_mal.mk index 5b7788e562..275524ee6c 100644 --- a/impls/make/stepA_mal.mk +++ b/impls/make/stepA_mal.mk @@ -2,8 +2,6 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)readline.mk -include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -11,199 +9,168 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash +INTERACTIVE ?= yes +EVAL_DEBUG ?= # READ: read and parse input define READ -$(READ_STR) +$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) endef # EVAL: evaluate the parameter -# If $1 is empty, `foreach` does no iteration at all. -starts_with? = $(foreach f,$(firstword $1)\ - ,$(and $(call _symbol?,$f),\ - $(filter $2,$(call _symbol_val,$f)))) - # elt, accumulator list -> new accumulator list -QQ_LOOP = $(if $(and $(_list?),\ - $(call starts_with?,$(_seq_vals),splice-unquote))\ - ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ - ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) +QQ_LOOP = $(call _list,\ + $(if $(and $(_list?),$(call _EQ,splice-unquote,$($(sfirst)_value))),\ + $(call _symbol,concat) $(call _nth,$1,1),\ + $(call _symbol,cons) $(QUASIQUOTE))\ + $2) # list or vector source -> right folded list -QQ_FOLD = $(if $1\ - ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ - ),$(call list)) - -QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) -QUASIQUOTE_nil = $1 -QUASIQUOTE_true = $1 -QUASIQUOTE_false = $1 -QUASIQUOTE_string = $1 -QUASIQUOTE_number = $1 -QUASIQUOTE_keyword = $1 -QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) -QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) - -QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) - -QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ - ,$(lastword $(_seq_vals))$(rem \ - ),$(call QQ_FOLD,$(_seq_vals))) - -EVAL_special_quote = $1 - -EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) - -EVAL_nil = $1 -EVAL_true = $1 -EVAL_false = $1 -EVAL_string = $1 -EVAL_number = $1 -EVAL_keyword = $1 - -EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) - -EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) - -# First foreach defines a constant, second one loops on keys. -define EVAL_map -$(foreach obj,$(call _map_new)\ -,$(obj)$(rem $(foreach k,$(_keys)\ - ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) -endef - -define EVAL_list -$(if $(_seq_vals)\ - ,$(foreach a0,$(firstword $(_seq_vals))\ - ,$(if $(call _symbol?,$(a0))\ - ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ - ,$(if $(filter undefined,$(flavor $(dispatch)))\ - ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ - ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ - ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ - ),$1) -endef - -define EVAL_apply -$(foreach f,$(call EVAL,$(firstword $1),$2)\ -,$(if $(__ERROR)\ - ,,$(if $(call _macro?,$f)\ - ,$(call EVAL,$(call _apply,$f,$(_rest)),$2)$(rem \ - ),$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2)))))) -endef - -define EVAL_special_defmacro! -$(foreach res,$(call _as_macro,$(call EVAL,$(lastword $1),$2))\ - ,$(res)$(call ENV_SET,$2,$(firstword $1),$(res))) -endef - -define EVAL_special_def! -$(foreach res,$(call EVAL,$(lastword $1),$2)\ - ,$(if $(__ERROR)\ - ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) -endef - -define EVAL_special_let* -$(foreach let_env,$(call ENV,$2)\ -,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ - ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ -)$(call EVAL,$(lastword $1),$(let_env))) +QQ_FOLD = $(if $(_empty?),$(call _list,),$(call QQ_LOOP,$(sfirst),$(call QQ_FOLD,$(srest)))) + +QUASIQUOTE = $(strip \ + $(if $(_list?), $(if $(call _EQ,unquote,$($(sfirst)_value)),\ + $(call _nth,$1,1),\ + $(QQ_FOLD)),\ + $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ + $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ + $1)))) +define LET +$(strip \ + $(word 1,$(2) \ + $(foreach var,$(call _nth,$(1),0),\ + $(foreach val,$(call _nth,$(1),1),\ + $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ + $(foreach left,$(call srest,$(call srest,$(1))), + $(if $(call _EQ,0,$(call _count,$(left))),\ + ,\ + $(call LET,$(left),$(2)))))))) endef -EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) - -define EVAL_special_if -$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ - ,$(call EVAL,$(word 2,$1),$2)$(rem \ -),$(if $(word 3,$1)\ - ,$(call EVAL,$(lastword $1),$2)$(rem \ -),$(__nil))) -endef - -EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) - -# EVAL may fail and return nothing, so the first foreach may execute -# nothing, so we need to duplicate the test for error. -# The second foreach deliberately does nothing when there is no -# catch_list. -define EVAL_special_try* -$(foreach res,$(call EVAL,$(firstword $1),$2)\ - ,$(if $(__ERROR)\ - ,,$(res)))$(rem \ -)$(if $(__ERROR)\ - ,$(foreach catch_list,$(word 2,$1)\ - ,$(foreach env,$(call ENV,$2)\ - ,$(call ENV_SET,$(env),$(word 2,$(call _seq_vals,$(catch_list))),$(__ERROR))$(rem \ - )$(eval __ERROR :=)$(rem \ - )$(call EVAL,$(lastword $(call _seq_vals,$(catch_list))),$(env))))) -endef - -define EVAL_special_make* -$(eval __result := $(call str_decode_nospace,$(_string_val)))$(rem \ -)$(call _string,$(call str_encode_nospace,$(__result))) +define EVAL_INVOKE +$(if $(__ERROR),,\ + $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) + $(foreach a0,$(call _nth,$(1),0),\ + $(if $(call _EQ,def!,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach res,$(call EVAL,$(a2),$(2)),\ + $(if $(__ERROR),,\ + $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ + $(if $(call _EQ,let*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ + $(if $(call _EQ,quote,$($(a0)_value)),\ + $(call _nth,$(1),1),\ + $(if $(call _EQ,quasiquote,$($(a0)_value)),\ + $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ + $(if $(call _EQ,defmacro!,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach res,$(call _clone_obj,$(call EVAL,$(a2),$(2))),\ + $(eval _macro_$(res) = true)\ + $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ + $(if $(call _EQ,make*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(and $(EVAL_DEBUG),$(info make*: $$(eval __result := $(call str_decode,$(value $(a1)_value)))))\ + $(eval __result := $(call str_decode,$(value $(a1)_value)))$(call _string,$(__result))),\ + $(if $(call _EQ,try*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach res,$(call EVAL,$(a1),$(2)),\ + $(if $(__ERROR),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach a20,$(call _nth,$(a2),0),\ + $(if $(call _EQ,catch*,$($(a20)_value)),\ + $(foreach a21,$(call _nth,$(a2),1),\ + $(foreach a22,$(call _nth,$(a2),2),\ + $(foreach binds,$(call _list,$(a21)),\ + $(foreach catch_env,$(call ENV,$(2),$(binds),$(__ERROR)),\ + $(eval __ERROR :=)\ + $(call EVAL,$(a22),$(catch_env)))))),\ + $(res)))),\ + $(res)))),\ + $(if $(call _EQ,do,$($(a0)_value)),\ + $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ + $(if $(call _EQ,if,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(foreach cond,$(call EVAL,$(a1),$(2)),\ + $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ + $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ + $(call EVAL,$(a2),$(2)))))),\ + $(if $(call _EQ,fn*,$($(a0)_value)),\ + $(foreach a1,$(call _nth,$(1),1),\ + $(foreach a2,$(call _nth,$(1),2),\ + $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ + $(foreach f,$(call EVAL,$(a0),$(2)),\ + $(foreach args,$(call srest,$(1)),\ + $(if $(_macro_$(f)),\ + $(call EVAL,$(call apply,$(f),$(args)),$(2)),\ + $(call apply,$(f),$(call _smap,EVAL,$(args),$(2)))))))))))))))))) endef define EVAL -$(if $(__ERROR)\ -,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ - ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ -)$(call EVAL_$(_obj_type),$1,$2)) +$(strip $(if $(__ERROR),,\ + $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ + $(info EVAL: $(_pr_str)))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(or $(call ENV_GET,$(2),$(key)),\ + $(call _error,'$(key)' not found)$(__nil))),\ + $(if $(call _vector?,$(1)),\ + $(call _smap_vec,EVAL,$(1),$(2)),\ + $(if $(call _hash_map?,$(1)),\ + $(foreach new_hmap,$(call __new_obj,hmap),\ + $(foreach v,$(call __get_obj_values,$(1)),\ + $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ + $(eval $(new_hmap)_size := $($(1)_size))\ + $(new_hmap)),\ + $(if $(call _list?,$(1)),\ + $(if $(call _EQ,0,$(call _count,$(1))),\ + $(1),\ + $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ + $(1))))))) endef # PRINT: define PRINT -$(if $(__ERROR)\ - ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ - ),$(call _pr_str,$1,yes)) +$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) - -# The foreach does nothing when line is empty (EOF). -define REPL -$(foreach line,$(call READLINE,user>$(_SP))\ -,$(eval __ERROR :=)$(rem \ -)$(call print,$(call REP,$(line:ok=)))$(rem \ -)$(call REPL)) -endef - -# Read and evaluate for side effects but ignore the result. -define RE -$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ -)$(if $(__ERROR)\ - ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) -endef +REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) +REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) # core.mk: defined using Make -$(foreach f,$(core_ns)\ - ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) - -core_eval = $(call EVAL,$1,$(REPL_ENV)) -$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) - -$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ - $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) +_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) +_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) +$(call _import_core,$(core_ns)) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) +_argv := $(call _list) +REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) # core.mal: defined in terms of the language itself -$(call RE, (def! not (fn* (a) (if a false true))) ) -$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) -$(call RE, (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))))))) ) -$(call RE, (def! *host-language* "make") ) +$(call do,$(call REP, (def! *host-language* "make") )) +$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) +$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) )) +$(call do,$(call 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))))))) )) -ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line -$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) -else +$(if $(MAKECMDGOALS),\ + $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ + $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ + $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ + $(eval INTERACTIVE :=),) + # repl loop -$(call RE, (println (str "Mal [" *host-language* "]")) ) -$(REPL) -endif +$(if $(strip $(INTERACTIVE)),\ + $(call do,$(call REP, (println (str "Mal [" *host-language* "]")) )) \ + $(call REPL)) -# Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true diff --git a/impls/make/util.mk b/impls/make/util.mk index 898e9ed28d..887798542b 100644 --- a/impls/make/util.mk +++ b/impls/make/util.mk @@ -8,34 +8,53 @@ __mal_util_included := true _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)gmsl.mk -encoded_equal := Ξ -encoded_colon := κ -encoded_slash := λ -raw_hash := \# -encoded_hash := η - +SEMI := ; COMMA := , COLON := : +LCURLY := { +RCURLY := } LPAREN := ( RPAREN := ) +LBRACKET := [ +RBRACKET := ] +DQUOTE := "# " SLASH := $(strip \ ) -SPACE := -SPACE := $(SPACE) $(SPACE) +ESC_DQUOTE := $(SLASH)$(DQUOTE) +ESC_N := $(SLASH)n +SQUOTE := '# ' +QQUOTE := `# ` +SPACE := $(hopefully_undefined) $(hopefully_undefined) +MINUS := - +NUMBERS := 0 1 2 3 4 5 6 7 8 9 +UNQUOTE := ~ +SPLICE_UNQUOTE := ~@ define NEWLINE endef +CARET := ^ +ATSIGN := @ +HASH := \# +_HASH := © # \u00ab _LP := « # \u00bb _RP := » +# \u00ed +_LC := í +# \u00ec +_RC := ì ## \u00a7 _SP := § ## \u00ae +_SUQ := ® +## \u015e _DOL := Åž ## \u00b6 _NL := ¶ +## \u00a8 +###_EDQ := ¨ # @@ -44,67 +63,38 @@ _NL := ¶ _EQ = $(if $(subst x$1,,x$2)$(subst x$2,,x$1),,true) -# reverse list of words -_reverse = $(if $1,$(call _reverse,$(_rest)) $(firstword $1)) +_NOT = $(if $1,,true) +# take a list of words and join them with a separator +# params: words, seperator, result +_join = $(strip \ + $(if $(strip $(1)),\ + $(if $(strip $(3)),\ + $(call _join,$(wordlist 2,$(words $(1)),$(1)),$(2),$(3)$(2)$(word 1,$(1))),\ + $(call _join,$(wordlist 2,$(words $(1)),$(1)),$(2),$(word 1,$(1)))),\ + $(3))) + +#$(info _join(1 2 3 4): [$(call _join,1 2 3 4)]) +#$(info _join(1 2 3 4,X): [$(call _join,1 2 3 4, )]) +#$(info _join(1): [$(call _join,1)]) +#$(info _join(): [$(call _join,)]) + +# reverse list of words +_reverse = $(if $(1),$(call _reverse,$(wordlist 2,$(words $(1)),$(1)))) $(firstword $(1)) #$(info reverse(1 2 3 4 5): $(call reverse,1 2 3 4 5)) # str_encode: take a string and return an encoded version of it with # every character separated by a space and special characters replaced # with special Unicode characters -define str_encode -$(eval __temp := $1)$(rem \ -)$(foreach a,$(encoded_slash) $(_DOL) $(_LP) $(_RP) $(_NL) \ - $(encoded_hash) $(encoded_colon) $(_SP) $(encoded_equal) $(gmsl_characters)\ - ,$(eval __temp := $$(subst $$a,$$a$$(SPACE),$(__temp))))$(rem \ -)$(__temp) -endef +str_encode = $(strip $(eval __temp := $$(subst $$$$,$(_DOL) ,$$(subst $(SPLICE_UNQUOTE),$(_SUQ) ,$$(subst $$(LPAREN),$$(_LP) ,$$(subst $$(RPAREN),$$(_RP) ,$$(subst $$(LCURLY),$$(_LC) ,$$(subst $$(RCURLY),$$(_RC) ,$$(subst $$(NEWLINE),$$(_NL) ,$$(subst $$(HASH),$(_HASH) ,$$(subst $$(SPACE),$(_SP) ,$$1))))))))))$(foreach a,$(gmsl_characters),$(eval __temp := $$(subst $$a,$$a$$(SPACE),$(__temp))))$(__temp)) # str_decode: take an encoded string an return an unencoded version of # it by replacing the special Unicode charactes with the real # characters and with all characters joined into a regular string -str_decode = $(subst $(SPACE),,$1) - -define str_encode_nospace -$(subst $(SLASH),$(encoded_slash),$(rem \ -)$(subst $$,$(_DOL),$(rem \ -)$(subst $(LPAREN),$(_LP),$(rem \ -)$(subst $(RPAREN),$(_RP),$(rem \ -)$(subst $(NEWLINE),$(_NL),$(rem \ -)$(subst $(raw_hash),$(encoded_hash),$(rem \ -)$(subst $(COLON),$(encoded_colon),$(rem \ -)$(subst $(SPACE),$(_SP),$(rem \ -)$(subst =,$(encoded_equal),$(rem \ -)$1))))))))) -endef - -define str_decode_nospace -$(subst $(encoded_slash),$(SLASH),$(rem \ -)$(subst $(_DOL),$$,$(rem \ -)$(subst $(_LP),$(LPAREN),$(rem \ -)$(subst $(_RP),$(RPAREN),$(rem \ -)$(subst $(_NL),$(NEWLINE),$(rem \ -)$(subst $(encoded_hash),$(raw_hash),$(rem \ -)$(subst $(encoded_colon),$(COLON),$(rem \ -)$(subst $(_SP),$(SPACE),$(rem \ -)$(subst $(encoded_equal),=,$1))))))))) -endef +str_decode = $(subst $(_SP),$(SPACE),$(subst $(_NL),$(NEWLINE),$(subst $(_LC),$(LCURLY),$(subst $(_RC),$(RCURLY),$(subst $(_LP),$(LPAREN),$(subst $(_RP),$(RPAREN),$(subst $(_SUQ),$(SPLICE_UNQUOTE),$(subst $(_DOL),$$,$(subst $(_HASH),$(HASH),$(strip $(call _join,$(1)))))))))))) # Read a whole file substituting newlines with $(_NL) -_read_file = $(call str_encode_nospace,$(shell \ - sed -z 's/\n/$(_NL)/g' '$(str_decode_nospace)')) - -print = $(info $(str_decode_nospace)) - -_rest = $(wordlist 2,$(words $1),$1) -_rest2 = $(wordlist 3,$(words $1),$1) - -# Evaluate $2 repeatedly with $k and $v set to key/value pairs from $1. -define _foreach2 -$(foreach k,$(firstword $1)\ - ,$(foreach v,$(word 2,$1)\ - ,$(eval $2)$(call _foreach2,$(_rest2),$2))) -endef +_read_file = $(subst $(_NL),$(NEWLINE),$(shell out=""; while read -r l; do out="$${out}$${l}$(_NL)"; done < $(1); echo "$$out")) endif diff --git a/impls/python/env.py b/impls/python/env.py index d20e19fdc8..813369d9ec 100644 --- a/impls/python/env.py +++ b/impls/python/env.py @@ -31,3 +31,7 @@ def get(self, key, return_nil=False): return None raise Exception("'" + key + "' not found") return env.data[key] + + def get_or_nil(self, key): + env = self.find(key) + if env: return env.data[key] diff --git a/impls/python/reader.py b/impls/python/reader.py index 6f76563870..c74b1a7395 100644 --- a/impls/python/reader.py +++ b/impls/python/reader.py @@ -1,6 +1,5 @@ import re - -from mal_types import (_symbol, _keyword, _list, List, Vector, Hash_Map, asPairs) +from mal_types import (_symbol, _keyword, _list, _vector, _hash_map, _s2u, _u) class Blank(Exception): pass @@ -24,7 +23,7 @@ def tokenize(str): return [t for t in re.findall(tre, str) if t[0] != ';'] def _unescape(s): - return s.replace('\\\\', '\b').replace('\\"', '"').replace('\\n', '\n').replace('\b', '\\') + return s.replace('\\\\', _u('\u029e')).replace('\\"', '"').replace('\\n', '\n').replace(_u('\u029e'), '\\') def read_atom(reader): int_re = re.compile(r"-?[0-9]+$") @@ -32,8 +31,8 @@ def read_atom(reader): string_re = re.compile(r'"(?:[\\].|[^\\"])*"') token = reader.next() if re.match(int_re, token): return int(token) - elif re.match(float_re, token): return int(token) - elif re.match(string_re, token):return _unescape(token[1:-1]) + elif re.match(float_re, token): return float(token) + elif re.match(string_re, token):return _s2u(_unescape(token[1:-1])) elif token[0] == '"': raise Exception("expected '\"', got EOF") elif token[0] == ':': return _keyword(token[1:]) elif token == "nil": return None @@ -41,26 +40,28 @@ def read_atom(reader): elif token == "false": return False else: return _symbol(token) -def read_sequence(reader, start='(', end=')'): +def read_sequence(reader, typ=list, start='(', end=')'): + ast = typ() token = reader.next() if token != start: raise Exception("expected '" + start + "'") token = reader.peek() while token != end: if not token: raise Exception("expected '" + end + "', got EOF") - yield read_form(reader) + ast.append(read_form(reader)) token = reader.peek() reader.next() + return ast def read_hash_map(reader): - lst = read_sequence(reader, '{', '}') - return Hash_Map(asPairs(lst)) + lst = read_sequence(reader, list, '{', '}') + return _hash_map(*lst) def read_list(reader): - return List(read_sequence(reader, '(', ')')) + return read_sequence(reader, _list, '(', ')') def read_vector(reader): - return Vector(read_sequence(reader, '[', ']')) + return read_sequence(reader, _vector, '[', ']') def read_form(reader): token = reader.peek() diff --git a/impls/python/step3_env.py b/impls/python/step3_env.py index 1bbac127e5..73f9699e2d 100644 --- a/impls/python/step3_env.py +++ b/impls/python/step3_env.py @@ -5,18 +5,19 @@ from env import Env # read -READ = reader.read_str +def READ(str): + return reader.read_str(str) # eval def EVAL(ast, env): - dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + dbgeval = env.get_or_nil('DEBUG-EVAL') if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types.Vector(EVAL(a, env) for a in ast) + return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -27,7 +28,6 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] - if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -35,19 +35,17 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for k, v in types.asPairs(a1): - let_env.set(k, EVAL(v, let_env)) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) return EVAL(a2, let_env) - - f = EVAL(a0, env) - if types._function_Q(f): + else: + f = EVAL(a0, env) args = ast[1:] return f(*(EVAL(a, env) for a in args)) - else: - raise Exception('Can only apply functions') # print -PRINT = printer._pr_str +def PRINT(exp): + return printer._pr_str(exp) # repl repl_env = Env() @@ -57,16 +55,15 @@ def REP(str): repl_env.set(types._symbol('+'), lambda a,b: a+b) repl_env.set(types._symbol('-'), lambda a,b: a-b) repl_env.set(types._symbol('*'), lambda a,b: a*b) -repl_env.set(types._symbol('/'), lambda a,b: a//b) +repl_env.set(types._symbol('/'), lambda a,b: int(a/b)) # repl loop while True: try: line = mal_readline.readline("user> ") + if line == None: break + if line == "": continue print(REP(line)) - except EOFError: - print() - break except reader.Blank: continue - except Exception: + except Exception as e: print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/impls/python/step4_if_fn_do.py b/impls/python/step4_if_fn_do.py index 7845121364..e04e98e5ef 100644 --- a/impls/python/step4_if_fn_do.py +++ b/impls/python/step4_if_fn_do.py @@ -6,18 +6,19 @@ import core # read -READ = reader.read_str +def READ(str): + return reader.read_str(str) # eval def EVAL(ast, env): - dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + dbgeval = env.get_or_nil('DEBUG-EVAL') if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types.Vector(EVAL(a, env) for a in ast) + return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -28,7 +29,6 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] - if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -36,8 +36,8 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for k, v in types.asPairs(a1): - let_env.set(k, EVAL(v, let_env)) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) return EVAL(a2, let_env) elif "do" == a0: for i in range(1, len(ast)-1): @@ -47,27 +47,21 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: - if len(ast) > 3: - return EVAL(ast[3], env) - else: - return None + if len(ast) > 3: return EVAL(ast[3], env) + else: return None else: return EVAL(a2, env) elif "fn*" == a0: a1, a2 = ast[1], ast[2] - def fn(*args): - return EVAL(a2, Env(env, a1, args)) - return fn - - f = EVAL(a0, env) - if types._function_Q(f): + return types._function(EVAL, Env, a2, env, a1) + else: + f = EVAL(a0, env) args = ast[1:] return f(*(EVAL(a, env) for a in args)) - else: - raise Exception('Can only apply functions') # print -PRINT = printer._pr_str +def PRINT(exp): + return printer._pr_str(exp) # repl repl_env = Env() @@ -84,10 +78,9 @@ def REP(str): while True: try: line = mal_readline.readline("user> ") + if line == None: break + if line == "": continue print(REP(line)) - except EOFError: - print() - break except reader.Blank: continue - except Exception: + except Exception as e: print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/impls/python/step5_tco.py b/impls/python/step5_tco.py index e045200945..74eedbee09 100644 --- a/impls/python/step5_tco.py +++ b/impls/python/step5_tco.py @@ -6,20 +6,21 @@ import core # read -READ = reader.read_str +def READ(str): + return reader.read_str(str) # eval def EVAL(ast, env): while True: - dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + dbgeval = env.get_or_nil('DEBUG-EVAL') if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types.Vector(EVAL(a, env) for a in ast) + return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -30,7 +31,6 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] - if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -38,50 +38,40 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for k, v in types.asPairs(a1): - let_env.set(k, EVAL(v, let_env)) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env - continue # TCO + # Continue loop (TCO) elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] - continue # TCO + # Continue loop (TCO) elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: - if len(ast) > 3: - ast = ast[3] - continue # TCO - else: - return None + if len(ast) > 3: ast = ast[3] + else: ast = None else: ast = a2 - continue # TCO + # Continue loop (TCO) elif "fn*" == a0: a1, a2 = ast[1], ast[2] - def fn(*args): - return EVAL(a2, Env(env, a1, args)) - fn.__ast__ = a2 - fn.__gen_env__ = lambda args: Env(env, a1, args) - return fn - - f = EVAL(a0, env) - if types._function_Q(f): + return types._function(EVAL, Env, a2, env, a1) + else: + f = EVAL(a0, env) args = ast[1:] if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(EVAL(a, env) for a in args) - continue # TCO + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: return f(*(EVAL(a, env) for a in args)) - else: - raise Exception('Can only apply functions') # print -PRINT = printer._pr_str +def PRINT(exp): + return printer._pr_str(exp) # repl repl_env = Env() @@ -98,11 +88,9 @@ def REP(str): while True: try: line = mal_readline.readline("user> ") + if line == None: break + if line == "": continue print(REP(line)) - except EOFError: - print() - break except reader.Blank: continue - except Exception: - # See tests/step5_tco.mal in this directory. + except Exception as e: print("".join(traceback.format_exception(*sys.exc_info())[0:100])) diff --git a/impls/python/step6_file.py b/impls/python/step6_file.py index aed6e09f27..4c0278e977 100644 --- a/impls/python/step6_file.py +++ b/impls/python/step6_file.py @@ -6,20 +6,21 @@ import core # read -READ = reader.read_str +def READ(str): + return reader.read_str(str) # eval def EVAL(ast, env): while True: - dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + dbgeval = env.get_or_nil('DEBUG-EVAL') if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types.Vector(EVAL(a, env) for a in ast) + return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -30,7 +31,6 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] - if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -38,50 +38,40 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for k, v in types.asPairs(a1): - let_env.set(k, EVAL(v, let_env)) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env - continue # TCO + # Continue loop (TCO) elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] - continue # TCO + # Continue loop (TCO) elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: - if len(ast) > 3: - ast = ast[3] - continue # TCO - else: - return None + if len(ast) > 3: ast = ast[3] + else: ast = None else: ast = a2 - continue # TCO + # Continue loop (TCO) elif "fn*" == a0: a1, a2 = ast[1], ast[2] - def fn(*args): - return EVAL(a2, Env(env, a1, args)) - fn.__ast__ = a2 - fn.__gen_env__ = lambda args: Env(env, a1, args) - return fn - - f = EVAL(a0, env) - if types._function_Q(f): + return types._function(EVAL, Env, a2, env, a1) + else: + f = EVAL(a0, env) args = ast[1:] if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(EVAL(a, env) for a in args) - continue # TCO + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: return f(*(EVAL(a, env) for a in args)) - else: - raise Exception('Can only apply functions') # print -PRINT = printer._pr_str +def PRINT(exp): + return printer._pr_str(exp) # repl repl_env = Env() @@ -91,11 +81,11 @@ def REP(str): # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) -repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) +repl_env.set(types._symbol('*ARGV*'), types._list(*sys.argv[2:])) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") -REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if len(sys.argv) >= 2: REP('(load-file "' + sys.argv[1] + '")') @@ -105,11 +95,9 @@ def REP(str): while True: try: line = mal_readline.readline("user> ") + if line == None: break + if line == "": continue print(REP(line)) - except EOFError: - print() - break except reader.Blank: continue - except Exception: - # See tests/step5_tco.mal in this directory. - print("".join(traceback.format_exception(*sys.exc_info())[0:100])) + except Exception as e: + print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/impls/python/step7_quote.py b/impls/python/step7_quote.py index 21fe4e3436..89e8265cb1 100644 --- a/impls/python/step7_quote.py +++ b/impls/python/step7_quote.py @@ -7,47 +7,43 @@ import core # read -READ = reader.read_str +def READ(str): + return reader.read_str(str) # eval def qq_loop(acc, elt): - if types._list_Q(elt) \ - and len(elt) == 2 \ - and types._symbol_Q(elt[0]) \ - and elt[0] == 'splice-unquote': - return types._list(types._symbol('concat'), elt[1], acc) + if types._list_Q(elt) and len(elt) == 2 and elt[0] == u'splice-unquote': + return types._list(types._symbol(u'concat'), elt[1], acc) else: - return types._list(types._symbol('cons'), quasiquote(elt), acc) + return types._list(types._symbol(u'cons'), quasiquote(elt), acc) def qq_foldr(seq): return functools.reduce(qq_loop, reversed(seq), types._list()) def quasiquote(ast): if types._list_Q(ast): - if len(ast) == 2 \ - and types._symbol_Q(ast[0]) \ - and ast[0] == 'unquote': + if len(ast) == 2 and ast[0] == u'unquote': return ast[1] else: return qq_foldr(ast) elif types._hash_map_Q(ast) or types._symbol_Q(ast): - return types._list(types._symbol('quote'), ast) - elif types._vector_Q(ast): - return types._list(types._symbol('vec'), qq_foldr(ast)) + return types._list(types._symbol(u'quote'), ast) + elif types._vector_Q (ast): + return types._list(types._symbol(u'vec'), qq_foldr(ast)) else: return ast def EVAL(ast, env): while True: - dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + dbgeval = env.get_or_nil('DEBUG-EVAL') if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types.Vector(EVAL(a, env) for a in ast) + return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -58,7 +54,6 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] - if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -66,55 +61,45 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for k, v in types.asPairs(a1): - let_env.set(k, EVAL(v, let_env)) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env - continue # TCO + # Continue loop (TCO) elif "quote" == a0: return ast[1] elif "quasiquote" == a0: - ast = quasiquote(ast[1]) - continue # TCO + ast = quasiquote(ast[1]); + # Continue loop (TCO) elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] - continue # TCO + # Continue loop (TCO) elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: - if len(ast) > 3: - ast = ast[3] - continue # TCO - else: - return None + if len(ast) > 3: ast = ast[3] + else: ast = None else: ast = a2 - continue # TCO + # Continue loop (TCO) elif "fn*" == a0: a1, a2 = ast[1], ast[2] - def fn(*args): - return EVAL(a2, Env(env, a1, args)) - fn.__ast__ = a2 - fn.__gen_env__ = lambda args: Env(env, a1, args) - return fn - - f = EVAL(a0, env) - if types._function_Q(f): + return types._function(EVAL, Env, a2, env, a1) + else: + f = EVAL(a0, env) args = ast[1:] if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(EVAL(a, env) for a in args) - continue # TCO + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: return f(*(EVAL(a, env) for a in args)) - else: - raise Exception('Can only apply functions') # print -PRINT = printer._pr_str +def PRINT(exp): + return printer._pr_str(exp) # repl repl_env = Env() @@ -124,11 +109,11 @@ def REP(str): # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) -repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) +repl_env.set(types._symbol('*ARGV*'), types._list(*sys.argv[2:])) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") -REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') +REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") if len(sys.argv) >= 2: REP('(load-file "' + sys.argv[1] + '")') @@ -138,11 +123,9 @@ def REP(str): while True: try: line = mal_readline.readline("user> ") + if line == None: break + if line == "": continue print(REP(line)) - except EOFError: - print() - break except reader.Blank: continue - except Exception: - # See tests/step5_tco.mal in this directory. - print("".join(traceback.format_exception(*sys.exc_info())[0:100])) + except Exception as e: + print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/impls/python/step8_macros.py b/impls/python/step8_macros.py index 604b779534..25044b5235 100644 --- a/impls/python/step8_macros.py +++ b/impls/python/step8_macros.py @@ -7,47 +7,43 @@ import core # read -READ = reader.read_str +def READ(str): + return reader.read_str(str) # eval def qq_loop(acc, elt): - if types._list_Q(elt) \ - and len(elt) == 2 \ - and types._symbol_Q(elt[0]) \ - and elt[0] == 'splice-unquote': - return types._list(types._symbol('concat'), elt[1], acc) + if types._list_Q(elt) and len(elt) == 2 and elt[0] == u'splice-unquote': + return types._list(types._symbol(u'concat'), elt[1], acc) else: - return types._list(types._symbol('cons'), quasiquote(elt), acc) + return types._list(types._symbol(u'cons'), quasiquote(elt), acc) def qq_foldr(seq): return functools.reduce(qq_loop, reversed(seq), types._list()) def quasiquote(ast): if types._list_Q(ast): - if len(ast) == 2 \ - and types._symbol_Q(ast[0]) \ - and ast[0] == 'unquote': + if len(ast) == 2 and ast[0] == u'unquote': return ast[1] else: return qq_foldr(ast) elif types._hash_map_Q(ast) or types._symbol_Q(ast): - return types._list(types._symbol('quote'), ast) - elif types._vector_Q(ast): - return types._list(types._symbol('vec'), qq_foldr(ast)) + return types._list(types._symbol(u'quote'), ast) + elif types._vector_Q (ast): + return types._list(types._symbol(u'vec'), qq_foldr(ast)) else: return ast def EVAL(ast, env): while True: - dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + dbgeval = env.get_or_nil('DEBUG-EVAL') if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types.Vector(EVAL(a, env) for a in ast) + return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -58,7 +54,6 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] - if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -66,63 +61,52 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for k, v in types.asPairs(a1): - let_env.set(k, EVAL(v, let_env)) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env - continue # TCO + # Continue loop (TCO) elif "quote" == a0: return ast[1] elif "quasiquote" == a0: - ast = quasiquote(ast[1]) - continue # TCO + ast = quasiquote(ast[1]); + # Continue loop (TCO) elif 'defmacro!' == a0: - func = EVAL(ast[2], env) - func = types._clone(func) + func = types._clone(EVAL(ast[2], env)) func._ismacro_ = True return env.set(ast[1], func) elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] - continue # TCO + # Continue loop (TCO) elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: - if len(ast) > 3: - ast = ast[3] - continue # TCO - else: - return None + if len(ast) > 3: ast = ast[3] + else: ast = None else: ast = a2 - continue # TCO + # Continue loop (TCO) elif "fn*" == a0: a1, a2 = ast[1], ast[2] - def fn(*args): - return EVAL(a2, Env(env, a1, args)) - fn.__ast__ = a2 - fn.__gen_env__ = lambda args: Env(env, a1, args) - return fn - - f = EVAL(a0, env) - if types._function_Q(f): + return types._function(EVAL, Env, a2, env, a1) + else: + f = EVAL(a0, env) args = ast[1:] if hasattr(f, '_ismacro_'): ast = f(*args) continue # TCO if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(EVAL(a, env) for a in args) - continue # TCO + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: return f(*(EVAL(a, env) for a in args)) - else: - raise Exception('Can only apply functions') # print -PRINT = printer._pr_str +def PRINT(exp): + return printer._pr_str(exp) # repl repl_env = Env() @@ -132,16 +116,12 @@ def REP(str): # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) -repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) +repl_env.set(types._symbol('*ARGV*'), types._list(*sys.argv[2:])) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") -REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') -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("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +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)))))))") if len(sys.argv) >= 2: REP('(load-file "' + sys.argv[1] + '")') @@ -151,11 +131,9 @@ def REP(str): while True: try: line = mal_readline.readline("user> ") + if line == None: break + if line == "": continue print(REP(line)) - except EOFError: - print() - break except reader.Blank: continue - except Exception: - # See tests/step5_tco.mal in this directory. - print("".join(traceback.format_exception(*sys.exc_info())[0:100])) + except Exception as e: + print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/impls/python/step9_try.py b/impls/python/step9_try.py index 5d149f6b6c..17aff4d171 100644 --- a/impls/python/step9_try.py +++ b/impls/python/step9_try.py @@ -7,47 +7,43 @@ import core # read -READ = reader.read_str +def READ(str): + return reader.read_str(str) # eval def qq_loop(acc, elt): - if types._list_Q(elt) \ - and len(elt) == 2 \ - and types._symbol_Q(elt[0]) \ - and elt[0] == 'splice-unquote': - return types._list(types._symbol('concat'), elt[1], acc) + if types._list_Q(elt) and len(elt) == 2 and elt[0] == u'splice-unquote': + return types._list(types._symbol(u'concat'), elt[1], acc) else: - return types._list(types._symbol('cons'), quasiquote(elt), acc) + return types._list(types._symbol(u'cons'), quasiquote(elt), acc) def qq_foldr(seq): return functools.reduce(qq_loop, reversed(seq), types._list()) def quasiquote(ast): if types._list_Q(ast): - if len(ast) == 2 \ - and types._symbol_Q(ast[0]) \ - and ast[0] == 'unquote': + if len(ast) == 2 and ast[0] == u'unquote': return ast[1] else: return qq_foldr(ast) elif types._hash_map_Q(ast) or types._symbol_Q(ast): - return types._list(types._symbol('quote'), ast) - elif types._vector_Q(ast): - return types._list(types._symbol('vec'), qq_foldr(ast)) + return types._list(types._symbol(u'quote'), ast) + elif types._vector_Q (ast): + return types._list(types._symbol(u'vec'), qq_foldr(ast)) else: return ast def EVAL(ast, env): while True: - dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + dbgeval = env.get_or_nil('DEBUG-EVAL') if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types.Vector(EVAL(a, env) for a in ast) + return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -58,7 +54,6 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] - if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -66,27 +61,28 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for k, v in types.asPairs(a1): - let_env.set(k, EVAL(v, let_env)) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env - continue # TCO + # Continue loop (TCO) elif "quote" == a0: return ast[1] elif "quasiquote" == a0: - ast = quasiquote(ast[1]) - continue # TCO + ast = quasiquote(ast[1]); + # Continue loop (TCO) elif 'defmacro!' == a0: - func = EVAL(ast[2], env) - func = types._clone(func) + func = types._clone(EVAL(ast[2], env)) func._ismacro_ = True return env.set(ast[1], func) + elif "py!*" == a0: + exec(compile(ast[1], '', 'single'), globals()) + return None elif "try*" == a0: if len(ast) < 3: - ast = ast[1] - continue # TCO - else: - a1, a2 = ast[1], ast[2] + return EVAL(ast[1], env) + a1, a2 = ast[1], ast[2] + if a2[0] == "catch*": err = None try: return EVAL(a1, env) @@ -95,51 +91,41 @@ def EVAL(ast, env): except Exception as exc: err = exc.args[0] catch_env = Env(env, [a2[1]], [err]) - ast = a2[2] - env = catch_env - continue # TCO + return EVAL(a2[2], catch_env) + else: + return EVAL(a1, env); elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] - continue # TCO + # Continue loop (TCO) elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: - if len(ast) > 3: - ast = ast[3] - continue # TCO - else: - return None + if len(ast) > 3: ast = ast[3] + else: ast = None else: ast = a2 - continue # TCO + # Continue loop (TCO) elif "fn*" == a0: a1, a2 = ast[1], ast[2] - def fn(*args): - return EVAL(a2, Env(env, a1, args)) - fn.__ast__ = a2 - fn.__gen_env__ = lambda args: Env(env, a1, args) - return fn - - f = EVAL(a0, env) - if types._function_Q(f): + return types._function(EVAL, Env, a2, env, a1) + else: + f = EVAL(a0, env) args = ast[1:] if hasattr(f, '_ismacro_'): ast = f(*args) continue # TCO if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(EVAL(a, env) for a in args) - continue # TCO + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: return f(*(EVAL(a, env) for a in args)) - else: - raise Exception('Can only apply functions') # print -PRINT = printer._pr_str +def PRINT(exp): + return printer._pr_str(exp) # repl repl_env = Env() @@ -149,16 +135,12 @@ def REP(str): # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) -repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) +repl_env.set(types._symbol('*ARGV*'), types._list(*sys.argv[2:])) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") -REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') -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("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +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)))))))") if len(sys.argv) >= 2: REP('(load-file "' + sys.argv[1] + '")') @@ -168,13 +150,11 @@ def REP(str): while True: try: line = mal_readline.readline("user> ") + if line == None: break + if line == "": continue print(REP(line)) - except EOFError: - print() - break except reader.Blank: continue except types.MalException as e: print("Error:", printer._pr_str(e.object)) - except Exception: - # See tests/step5_tco.mal in this directory. - print("".join(traceback.format_exception(*sys.exc_info())[0:100])) + except Exception as e: + print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/impls/python/stepA_mal.py b/impls/python/stepA_mal.py index 4560b0896b..b8455ac105 100644 --- a/impls/python/stepA_mal.py +++ b/impls/python/stepA_mal.py @@ -7,47 +7,43 @@ import core # read -READ = reader.read_str +def READ(str): + return reader.read_str(str) # eval def qq_loop(acc, elt): - if types._list_Q(elt) \ - and len(elt) == 2 \ - and types._symbol_Q(elt[0]) \ - and elt[0] == 'splice-unquote': - return types._list(types._symbol('concat'), elt[1], acc) + if types._list_Q(elt) and len(elt) == 2 and elt[0] == u'splice-unquote': + return types._list(types._symbol(u'concat'), elt[1], acc) else: - return types._list(types._symbol('cons'), quasiquote(elt), acc) + return types._list(types._symbol(u'cons'), quasiquote(elt), acc) def qq_foldr(seq): return functools.reduce(qq_loop, reversed(seq), types._list()) def quasiquote(ast): if types._list_Q(ast): - if len(ast) == 2 \ - and types._symbol_Q(ast[0]) \ - and ast[0] == 'unquote': + if len(ast) == 2 and ast[0] == u'unquote': return ast[1] else: return qq_foldr(ast) elif types._hash_map_Q(ast) or types._symbol_Q(ast): - return types._list(types._symbol('quote'), ast) - elif types._vector_Q(ast): - return types._list(types._symbol('vec'), qq_foldr(ast)) + return types._list(types._symbol(u'quote'), ast) + elif types._vector_Q (ast): + return types._list(types._symbol(u'vec'), qq_foldr(ast)) else: return ast def EVAL(ast, env): while True: - dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) + dbgeval = env.get_or_nil('DEBUG-EVAL') if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types.Vector(EVAL(a, env) for a in ast) + return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -58,7 +54,6 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] - if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -66,19 +61,18 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for k, v in types.asPairs(a1): - let_env.set(k, EVAL(v, let_env)) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) ast = a2 env = let_env - continue # TCO + # Continue loop (TCO) elif "quote" == a0: return ast[1] elif "quasiquote" == a0: - ast = quasiquote(ast[1]) - continue # TCO + ast = quasiquote(ast[1]); + # Continue loop (TCO) elif 'defmacro!' == a0: - func = EVAL(ast[2], env) - func = types._clone(func) + func = types._clone(EVAL(ast[2], env)) func._ismacro_ = True return env.set(ast[1], func) elif "py!*" == a0: @@ -92,10 +86,9 @@ def EVAL(ast, env): return f(*el) elif "try*" == a0: if len(ast) < 3: - ast = ast[1] - continue # TCO - else: - a1, a2 = ast[1], ast[2] + return EVAL(ast[1], env) + a1, a2 = ast[1], ast[2] + if a2[0] == "catch*": err = None try: return EVAL(a1, env) @@ -104,51 +97,41 @@ def EVAL(ast, env): except Exception as exc: err = exc.args[0] catch_env = Env(env, [a2[1]], [err]) - ast = a2[2] - env = catch_env - continue # TCO + return EVAL(a2[2], catch_env) + else: + return EVAL(a1, env); elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] - continue # TCO + # Continue loop (TCO) elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: - if len(ast) > 3: - ast = ast[3] - continue # TCO - else: - return None + if len(ast) > 3: ast = ast[3] + else: ast = None else: ast = a2 - continue # TCO + # Continue loop (TCO) elif "fn*" == a0: a1, a2 = ast[1], ast[2] - def fn(*args): - return EVAL(a2, Env(env, a1, args)) - fn.__ast__ = a2 - fn.__gen_env__ = lambda args: Env(env, a1, args) - return fn - - f = EVAL(a0, env) - if types._function_Q(f): + return types._function(EVAL, Env, a2, env, a1) + else: + f = EVAL(a0, env) args = ast[1:] if hasattr(f, '_ismacro_'): ast = f(*args) continue # TCO if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(EVAL(a, env) for a in args) - continue # TCO + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: return f(*(EVAL(a, env) for a in args)) - else: - raise Exception('Can only apply functions') # print -PRINT = printer._pr_str +def PRINT(exp): + return printer._pr_str(exp) # repl repl_env = Env() @@ -158,34 +141,28 @@ def REP(str): # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) -repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) +repl_env.set(types._symbol('*ARGV*'), types._list(*sys.argv[2:])) # core.mal: defined using the language itself -REP('(def! *host-language* "python")') +REP("(def! *host-language* \"python\")") REP("(def! not (fn* (a) (if a false true)))") -REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') -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("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +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)))))))") if len(sys.argv) >= 2: REP('(load-file "' + sys.argv[1] + '")') sys.exit(0) # repl loop -REP('(println (str "Mal [" *host-language* "]"))') +REP("(println (str \"Mal [\" *host-language* \"]\"))") while True: try: line = mal_readline.readline("user> ") + if line == None: break + if line == "": continue print(REP(line)) - except EOFError: - print() - break except reader.Blank: continue except types.MalException as e: print("Error:", printer._pr_str(e.object)) - except Exception: - # See tests/step5_tco.mal in this directory. - print("".join(traceback.format_exception(*sys.exc_info())[0:100])) + except Exception as e: + print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/process/guide.md b/process/guide.md index ce549884b1..5e528a7d32 100644 --- a/process/guide.md +++ b/process/guide.md @@ -310,7 +310,7 @@ expression support. * Add a `reader.qx` file to hold functions related to the reader. -* If the target language has object types (OOP), then the next step +* If the target language has objects types (OOP), then the next step is to create a simple stateful Reader object in `reader.qx`. This object will store the tokens and a position. The Reader object will have two methods: `next` and `peek`. `next` returns the token at @@ -368,7 +368,7 @@ expression support. * Add the function `read_list` to `reader.qx`. This function will repeatedly call `read_form` with the Reader object until it - encounters a ')' token (if it reaches EOF before reading a ')' then + encounters a ')' token (if it reach EOF before reading a ')' then that is an error). It accumulates the results into a List type. If your language does not have a sequential data type that can hold mal type values you may need to implement one (in `types.qx`). Note @@ -384,7 +384,7 @@ expression support. the other fundamental mal types: nil, true, false, and string. The remaining scalar mal type, keyword does not need to be implemented until step A (but can be implemented at any - point between this step and that). BTW, symbol types are just an + point between this step and that). BTW, symbols types are just an object that contains a single string name value (some languages have symbol types already). @@ -522,7 +522,7 @@ functionality to the evaluator (`EVAL`). Compare the pseudocode for step 1 and step 2 to get a basic idea of the changes that will be made during this step: ``` -diff -u ../process/step1_read_print.txt ../process/step2_eval.txt +diff -urp ../process/step1_read_print.txt ../process/step2_eval.txt ``` * Copy `step1_read_print.qx` to `step2_eval.qx`. @@ -568,7 +568,7 @@ Try some simple expressions: * `(+ 2 (* 3 4))` -> `14` The most likely challenge you will encounter is how to properly call -a function reference using an arguments list. +a function references using an arguments list. Now go to the top level, run the step 2 tests and fix the errors. ``` @@ -623,7 +623,7 @@ chain). Compare the pseudocode for step 2 and step 3 to get a basic idea of the changes that will be made during this step: ``` -diff -u ../process/step2_eval.txt ../process/step3_env.txt +diff -urp ../process/step2_eval.txt ../process/step3_env.txt ``` * Copy `step2_eval.qx` to `step3_env.qx`. @@ -741,7 +741,7 @@ In some Lisps, this special form is named "lambda". Compare the pseudocode for step 3 and step 4 to get a basic idea of the changes that will be made during this step: ``` -diff -u ../process/step3_env.txt ../process/step4_if_fn_do.txt +diff -urp ../process/step3_env.txt ../process/step4_if_fn_do.txt ``` * Copy `step3_env.qx` to `step4_if_fn_do.qx`. @@ -804,7 +804,7 @@ Try out the basic functionality you have implemented: * Add the following functions to `core.ns`: * `prn`: call `pr_str` on the first parameter with `print_readably` - set to true, print the result to the screen and then return + set to true, prints the result to the screen and then return `nil`. Note that the full version of `prn` is a deferrable below. * `list`: take the parameters and return them as a list. * `list?`: return true if the first parameter is a list, false @@ -848,7 +848,7 @@ from a neat toy to a full featured language. call the `rep` function with this string: "(def! not (fn* (a) (if a false true)))". -* Implement the string functions in `core.qx`. To implement these +* Implement the strings functions in `core.qx`. To implement these functions, you will need to implement the string support in the reader and printer (deferrable section of step 1). Each of the string functions takes multiple mal values, prints them (`pr_str`) and @@ -892,7 +892,7 @@ iteration. Compare the pseudocode for step 4 and step 5 to get a basic idea of the changes that will be made during this step: ``` -diff -u ../process/step4_if_fn_do.txt ../process/step5_tco.txt +diff -urp ../process/step4_if_fn_do.txt ../process/step5_tco.txt ``` * Copy `step4_if_fn_do.qx` to `step5_tco.qx`. @@ -939,8 +939,8 @@ diff -u ../process/step4_if_fn_do.txt ../process/step5_tco.txt before (in step 4). * a `fn*` value: set `ast` to the `ast` attribute of `f`. Generate a new environment using the `env` and `params` attributes of `f` - as the `outer` and `binds` arguments and `args` as the `exprs` - argument. Set `env` to the new environment. Continue at the + as the `outer` and `binds` arguments and `args` as the `exprs` + argument. Set `env` to the new environment. Continue at the beginning of the loop. Run some manual tests from previous steps to make sure you have not @@ -982,7 +982,7 @@ holding off on that you will need to go back and do so. Compare the pseudocode for step 5 and step 6 to get a basic idea of the changes that will be made during this step: ``` -diff -u ../process/step5_tco.txt ../process/step6_file.txt +diff -urp ../process/step5_tco.txt ../process/step6_file.txt ``` * Copy `step5_tco.qx` to `step6_file.qx`. @@ -1056,7 +1056,7 @@ You'll need to add 5 functions to the core namespace to support atoms: Optionally, you can add a reader macro `@` which will serve as a short form for `deref`, so that `@a` is equivalent to `(deref a)`. In order to do that, modify -the conditional in reader function `read_form` and add a case which deals with +the conditional in reader `read_form` function and add a case which deals with the `@` token: if the token is `@` (at sign) then return a new list that contains the symbol `deref` and the result of reading the next form (`read_form`). @@ -1121,7 +1121,7 @@ value that it evaluates to. Likewise with lists. For example, consider the following: * `(prn abc)`: this will lookup the symbol `abc` in the current - evaluation environment and print it. This will result in an error if + evaluation environment and print it. This will result in error if `abc` is not defined. * `(prn (quote abc))`: this will print "abc" (prints the symbol itself). This will work regardless of whether `abc` is defined in @@ -1154,7 +1154,7 @@ manifest when it is used together with macros (in the next step). Compare the pseudocode for step 6 and step 7 to get a basic idea of the changes that will be made during this step: ``` -diff -u ../process/step6_file.txt ../process/step7_quote.txt +diff -urp ../process/step6_file.txt ../process/step7_quote.txt ``` * Copy `step6_file.qx` to `step7_quote.qx`. @@ -1184,7 +1184,7 @@ Mal borrows most of its syntax and feature-set). following conditional. - If `ast` is a list starting with the "unquote" symbol, return its second element. - - If `ast` is a list failing the previous test, the result will be a + - If `ast` is a list failing previous test, the result will be a list populated by the following process. The result is initially an empty list. @@ -1219,6 +1219,7 @@ Mal borrows most of its syntax and feature-set). as in the previous case if implementation is easier. * Add the `quasiquote` special form. + This form calls the `quasiquote` function using the first `ast` argument (second list element), then evaluates the result in the current environment, @@ -1249,8 +1250,8 @@ macros. short-hand syntaxes are known as reader macros because they allow us to manipulate mal code during the reader phase. Macros that run during the eval phase are just called "macros" and are described in - the next section. Expand the conditional in reader function - `read_form` to add the following four cases: + the next section. Expand the conditional with reader `read_form` + function to add the following four cases: * token is "'" (single quote): return a new list that contains the symbol "quote" and the result of reading the next form (`read_form`). @@ -1298,7 +1299,7 @@ the mal language itself. Compare the pseudocode for step 7 and step 8 to get a basic idea of the changes that will be made during this step: ``` -diff -u ../process/step7_quote.txt ../process/step8_macros.txt +diff -urp ../process/step7_quote.txt ../process/step8_macros.txt ``` * Copy `step7_quote.qx` to `step8_macros.qx`. @@ -1347,7 +1348,6 @@ There is a reasonably good chance that the macro tests will not pass the first time. Although the implementation of macros is fairly simple, debugging runtime bugs with macros can be fairly tricky. If you do run into subtle problems that are difficult to solve, let me - recommend an approach: * Enable the debug print statement at the top of your main `eval` @@ -1384,11 +1384,11 @@ implementation. Let us continue! as arguments, returns the element of the list at the given index. If the index is out of range, this function raises an exception. * `first`: this function takes a list (or vector) as its argument - and returns the first element. If the list (or vector) is empty or + and return the first element. If the list (or vector) is empty or is `nil` then `nil` is returned. * `rest`: this function takes a list (or vector) as its argument and returns a new list containing all the elements except the first. If - the list (or vector) is empty or is `nil` then `()` (empty list) + the list (or vector) is empty or is `nil` then `()` (empty list) is returned. * In the main program, call the `rep` function with the following @@ -1417,7 +1417,7 @@ functional programming pedigree of your implementation by adding the Compare the pseudocode for step 8 and step 9 to get a basic idea of the changes that will be made during this step: ``` -diff -u ../process/step8_macros.txt ../process/step9_try.txt +diff -urp ../process/step8_macros.txt ../process/step9_try.txt ``` * Copy `step8_macros.qx` to `step9_try.qx`. @@ -1479,7 +1479,7 @@ diff -u ../process/step8_macros.txt ../process/step9_try.txt function against every element of the list (or vector) one at a time and returns the results as a list. -* Add some type predicate core functions. In Lisp, predicates are +* Add some type predicates core functions. In Lisp, predicates are functions that return true/false (or true value/nil) and typically end in "?" or "p". * `nil?`: takes a single argument and returns true (mal true value) @@ -1574,7 +1574,7 @@ implementation to self-host. Compare the pseudocode for step 9 and step A to get a basic idea of the changes that will be made during this step: ``` -diff -u ../process/step9_try.txt ../process/stepA_mal.txt +diff -urp ../process/step9_try.txt ../process/stepA_mal.txt ``` * Copy `step9_try.qx` to `stepA_mal.qx`. @@ -1607,7 +1607,7 @@ make "test^quux^stepA" Once you have passed all the non-optional step A tests, it is time to try self-hosting. Run your step A implementation as normal, but use -the file argument mode you added in step 6 to run each step +the file argument mode you added in step 6 to run a each of the step from the mal implementation: ``` ./stepA_mal.qx ../mal/step1_read_print.mal @@ -1661,17 +1661,17 @@ implementation. * `meta`: this takes a single mal function/list/vector/hash-map argument and returns the value of the metadata attribute. * `with-meta`: this function takes two arguments. The first argument - is a mal value and the second argument is another mal value/type - to set as metadata. A copy of the mal value is returned that has - its `meta` attribute set to the second argument. Note that when - copying a mal function, it is important that the environment and - macro attribute are retained. + is a mal function/list/vector/hash-map and the second argument is + another mal value/type to set as metadata. A copy of the mal function is + returned that has its `meta` attribute set to the second argument. + Note that it is important that the environment and macro attribute + of mal function are retained when it is copied. * Add a reader-macro that expands the token "^" to return a new list that contains the symbol "with-meta" and the result of reading the next next form (2nd argument) (`read_form`) and the next form (1st argument) in that order (metadata comes first with the ^ macro and the function second). - * If you implemented `defmacro!` as mutating an existing function + * If you implemented as `defmacro!` to mutate an existing function without copying it, you can now use the function copying mechanism used for metadata to make functions immutable even in the defmacro! case... @@ -1698,7 +1698,7 @@ implementation. * `seq`: takes a list, vector, string, or nil. If an empty list, empty vector, or empty string ("") is passed in then nil is returned. Otherwise, a list is returned unchanged, a vector is - converted into a list, and a string is converted to a list + converted into a list, and a string is converted to a list that containing the original string split into single character strings. * For interop with the target language, add this core function: diff --git a/runtest.py b/runtest.py index 2f8ebca08f..81f5101790 100755 --- a/runtest.py +++ b/runtest.py @@ -1,18 +1,22 @@ #!/usr/bin/env python - from __future__ import print_function import os, sys, re import argparse, time import signal, atexit - from subprocess import Popen, STDOUT, PIPE -from select import select - -# Pseudo-TTY and terminal manipulation -import pty, array, fcntl, termios IS_PY_3 = sys.version_info[0] == 3 +if os.name == 'posix': + from select import select +else: + if IS_PY_3: + import threading, queue + from subprocess import TimeoutExpired + else: + import threading + import Queue as queue + debug_file = None log_file = None @@ -83,80 +87,161 @@ def __init__(self, args, no_pty=False, line_break="\n"): env['TERM'] = 'dumb' env['INPUTRC'] = '/dev/null' env['PERL_RL'] = 'false' - if no_pty: - self.p = Popen(args, bufsize=0, - stdin=PIPE, stdout=PIPE, stderr=STDOUT, - preexec_fn=os.setsid, - env=env) - self.stdin = self.p.stdin - self.stdout = self.p.stdout + if os.name == 'posix': + if no_pty: + self.p = Popen(args, bufsize=0, + stdin=PIPE, stdout=PIPE, stderr=STDOUT, + preexec_fn=os.setsid, + env=env) + self.stdin = self.p.stdin + self.stdout = self.p.stdout + else: + # Pseudo-TTY and terminal manipulation + import pty, array, fcntl, termios + + # provide tty to get 'interactive' readline to work + master, slave = pty.openpty() + + # Set terminal size large so that readline will not send + # ANSI/VT escape codes when the lines are long. + buf = array.array('h', [100, 200, 0, 0]) + fcntl.ioctl(master, termios.TIOCSWINSZ, buf, True) + + self.p = Popen(args, bufsize=0, + stdin=slave, stdout=slave, stderr=STDOUT, + preexec_fn=os.setsid, + env=env) + # Now close slave so that we will get an exception from + # read when the child exits early + # http://stackoverflow.com/questions/11165521 + os.close(slave) + self.stdin = os.fdopen(master, 'r+b', 0) + self.stdout = self.stdin + elif os.name == 'nt': + if no_pty: + from subprocess import CREATE_NEW_PROCESS_GROUP + self.p = Popen(args, bufsize=0, + stdin=PIPE, stdout=PIPE, stderr=STDOUT, + creationflags=CREATE_NEW_PROCESS_GROUP, + env=env) + self.stdin = self.p.stdin + self.stdout = self.p.stdout + else: + raise ValueError('pty not supported on os.name="{}"'.format(os.name)) else: - # provide tty to get 'interactive' readline to work - master, slave = pty.openpty() - - # Set terminal size large so that readline will not send - # ANSI/VT escape codes when the lines are long. - buf = array.array('h', [100, 200, 0, 0]) - fcntl.ioctl(master, termios.TIOCSWINSZ, buf, True) - - self.p = Popen(args, bufsize=0, - stdin=slave, stdout=slave, stderr=STDOUT, - preexec_fn=os.setsid, - env=env) - # Now close slave so that we will get an exception from - # read when the child exits early - # http://stackoverflow.com/questions/11165521 - os.close(slave) - self.stdin = os.fdopen(master, 'r+b', 0) - self.stdout = self.stdin + if no_pty: + self.p = Popen(args, bufsize=0, + stdin=PIPE, stdout=PIPE, stderr=STDOUT, + env=env) + self.stdin = self.p.stdin + self.stdout = self.p.stdout + else: + raise ValueError('pty not supported on os.name="{}"'.format(os.name)) #print "started" self.buf = "" self.last_prompt = "" - self.line_break = line_break - def read_to_prompt(self, prompts, timeout): + if os.name == 'posix': + self.q = None + self.t = None + else: + self.q = queue.Queue() + self.t = threading.Thread(target=self._reader, args=()) + self.t.daemon = True + self.t.start() + + def _reader(self): + try: + f = self.stdout + ok = True + while ok: + try: + new_data = f.read(1) + if len(new_data) == 0: # EOF + ok = False + except Exception as e: + # catch the read exception and send it to queue + ok = False + new_data = e + self.q.put(new_data) + except: + pass + + def read_to_prompt(self, prompts, timeout, search_prefix=''): end_time = time.time() + timeout - while time.time() < end_time: - [outs,_,_] = select([self.stdout], [], [], 1) - if self.stdout in outs: + while True: + current_timeout = max(end_time - time.time(), 0.) + if current_timeout == 0.: + break + if os.name == 'posix': + [outs,_,_] = select([self.stdout], [], [], 1) + if self.stdout not in outs: + continue new_data = self.stdout.read(1) - new_data = new_data.decode("latin1") if IS_PY_3 else new_data - #print("new_data: '%s'" % new_data) - debug(new_data) - # Perform newline cleanup - self.buf += new_data.replace("\r", "") - for prompt in prompts: - regexp = re.compile(prompt) - match = regexp.search(self.buf) - if match: - end = match.end() - buf = self.buf[0:match.start()] - self.buf = self.buf[end:] - self.last_prompt = prompt - return buf + + else: + try: + new_data = self.q.get(timeout=current_timeout) + except queue.Empty: + break + if isinstance(new_data, Exception): + raise new_data + if len(new_data) == 0: # EOF + break + new_data = new_data.decode("latin1") if IS_PY_3 else new_data + #print("new_data: '%s'" % new_data) + debug(new_data) + # Perform newline cleanup + self.buf += new_data.replace("\r", "") + for prompt in prompts: + regexp = re.compile(prompt) + match = regexp.search(search_prefix + self.buf) + if match: + start = match.start() - len(search_prefix) + end = match.end() - len(search_prefix) + buf = self.buf[0:start] + self.buf = self.buf[end:] + self.last_prompt = prompt + return buf + # MAYBE we should distinguish EOF from TIMEOUT, + # return None for both cases currently return None def writeline(self, str): def _to_bytes(s): return bytes(s, "latin1") if IS_PY_3 else s - - self.stdin.write(_to_bytes(str.replace('\r', '\x16\r') + self.line_break)) - + if os.name == 'posix': + self.stdin.write(_to_bytes(str.replace('\r', '\x16\r') + self.line_break)) + else: + self.stdin.write(_to_bytes(str + self.line_break)) + def cleanup(self): #print "cleaning up" if self.p: try: - os.killpg(self.p.pid, signal.SIGTERM) + if os.name == 'posix': + os.killpg(self.p.pid, signal.SIGTERM) + elif os.name == 'nt': + self.p.send_signal(signal.CTRL_BREAK_EVENT) + else: + self.p.terminate() + if IS_PY_3: + try: + self.p.communicate(timeout=1.0) + except TimeoutExpired: + self.p.kill() except OSError: pass self.p = None + self.stdin = None + self.stdout = None class TestReader: def __init__(self, test_file): self.line_num = 0 - f = open(test_file, newline='') if IS_PY_3 else open(test_file) + f = open(test_file) self.data = f.read().split('\n') self.soft = False self.deferrable = False @@ -267,6 +352,14 @@ def assert_prompt(runner, prompts, timeout): class TestTimeout(Exception): pass +def has_any_match(expects, res): + success = False + for expect in expects: + success = re.search(expect, res, re.S) + if success: + break + return success + while t.next(): if args.deferrable == False and t.deferrable: log(t.deferrable) @@ -287,14 +380,16 @@ class TestTimeout(Exception): # The repeated form is to get around an occasional OS X issue # where the form is repeated. # https://github.com/kanaka/mal/issues/30 - expects = [".*%s%s%s" % (sep, t.out, re.escape(t.ret)), - ".*%s.*%s%s%s" % (sep, sep, t.out, re.escape(t.ret))] + expects = ["%s%s" % (t.out, re.escape(t.ret)), # for Windows, WSL + ".*%s%s%s" % (sep, t.out, re.escape(t.ret)), # for Linux, OS X + ".*%s.*%s%s%s" % (sep, sep, t.out, re.escape(t.ret))] # for OS X r.writeline(t.form) try: test_cnt += 1 - res = r.read_to_prompt(['\r\n[^\\s()<>]+> ', '\n[^\\s()<>]+> '], - timeout=args.test_timeout) + # Search with prepending prefix '\n' for avoiding hangs on Windows + res = r.read_to_prompt(['\r\n[^\s()<>]+> ', '\n[^\s()<>]+> '], + timeout=args.test_timeout, search_prefix='\n') #print "%s,%s,%s" % (idx, repr(p.before), repr(p.after)) if (res == None): log(" -> TIMEOUT (line %d)" % t.line_num) @@ -302,8 +397,7 @@ class TestTimeout(Exception): elif (t.ret == "" and t.out == ""): log(" -> SUCCESS (result ignored)") pass_cnt += 1 - elif (re.search(expects[0], res, re.S) or - re.search(expects[1], res, re.S)): + elif has_any_match(expects, res): log(" -> SUCCESS") pass_cnt += 1 else: From 2f8e89417c4409f500b6aeddeff22d1e20bfcb81 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 13:47:39 +0800 Subject: [PATCH 061/129] vbs: Add extra option --no-pty for vbs impl --- Makefile.impls | 1 + 1 file changed, 1 insertion(+) diff --git a/Makefile.impls b/Makefile.impls index 9e4bbdc7d5..aed43333d9 100644 --- a/Makefile.impls +++ b/Makefile.impls @@ -77,6 +77,7 @@ else ifeq ($(MAL_IMPL),powershell) mal_TEST_OPTS = --start-timeout 60 --test-timeout 180 endif xslt_TEST_OPTS = --test-timeout 120 +vbs_TEST_OPTS = --no-pty # From 0b9b19c748033d4f8b21dd568dda45ec91920394 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 13:58:22 +0800 Subject: [PATCH 062/129] vbs: append bash before args --- runtest.py | 2 ++ 1 file changed, 2 insertions(+) diff --git a/runtest.py b/runtest.py index 81f5101790..f04bb0bc08 100755 --- a/runtest.py +++ b/runtest.py @@ -120,6 +120,8 @@ def __init__(self, args, no_pty=False, line_break="\n"): elif os.name == 'nt': if no_pty: from subprocess import CREATE_NEW_PROCESS_GROUP + # print(args) + args = ['bash'] + args self.p = Popen(args, bufsize=0, stdin=PIPE, stdout=PIPE, stderr=STDOUT, creationflags=CREATE_NEW_PROCESS_GROUP, From 1a79148dbcf8331391aa041201e8f1faa1cbdbbb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 14:32:28 +0800 Subject: [PATCH 063/129] vbs: cannot call bash from runtest.py, so call cmd & run.cmd --- runtest.py | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/runtest.py b/runtest.py index f04bb0bc08..ed184ccab2 100755 --- a/runtest.py +++ b/runtest.py @@ -120,8 +120,12 @@ def __init__(self, args, no_pty=False, line_break="\n"): elif os.name == 'nt': if no_pty: from subprocess import CREATE_NEW_PROCESS_GROUP - # print(args) - args = ['bash'] + args + + # replace args's forward slashes with backslashes for Windows + args = [arg.replace('/', '\\') for arg in args] + args = ['cmd', '/c'] + args + print(args) + self.p = Popen(args, bufsize=0, stdin=PIPE, stdout=PIPE, stderr=STDOUT, creationflags=CREATE_NEW_PROCESS_GROUP, From 72d1204a14bbf7affd8e0f843de0315690432c0e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 14:49:21 +0800 Subject: [PATCH 064/129] vbs: replace bash script with batch script --- impls/vbs/run | 2 -- impls/vbs/run.cmd | 5 +++++ runtest.py | 6 ++---- 3 files changed, 7 insertions(+), 6 deletions(-) delete mode 100644 impls/vbs/run create mode 100644 impls/vbs/run.cmd diff --git a/impls/vbs/run b/impls/vbs/run deleted file mode 100644 index fc01d3541f..0000000000 --- a/impls/vbs/run +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/bash -exec cscript -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" diff --git a/impls/vbs/run.cmd b/impls/vbs/run.cmd new file mode 100644 index 0000000000..d48387b3b2 --- /dev/null +++ b/impls/vbs/run.cmd @@ -0,0 +1,5 @@ +@echo off & setlocal +if not defined STEP set STEP=stepA_mal + +set "SCRIPT=%~dp0\%STEP%.vbs" +cscript //nologo "%SCRIPT%" %* \ No newline at end of file diff --git a/runtest.py b/runtest.py index ed184ccab2..ada6a54231 100755 --- a/runtest.py +++ b/runtest.py @@ -121,10 +121,8 @@ def __init__(self, args, no_pty=False, line_break="\n"): if no_pty: from subprocess import CREATE_NEW_PROCESS_GROUP - # replace args's forward slashes with backslashes for Windows - args = [arg.replace('/', '\\') for arg in args] - args = ['cmd', '/c'] + args - print(args) + # replace args's forward slashes & append ext name + args[0] = args[0].replace('/', '\\') + '.cmd' self.p = Popen(args, bufsize=0, stdin=PIPE, stdout=PIPE, stderr=STDOUT, From c8efda2e1cd80f29b85930c50717b715fb437631 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 15:09:59 +0800 Subject: [PATCH 065/129] vbs: add return values to the test samples I wrote myself --- impls/vbs/tests/step4_if_fn_do.mal | 14 +++++++++++++- impls/vbs/tests/step9_try.mal | 11 +++++++++-- 2 files changed, 22 insertions(+), 3 deletions(-) diff --git a/impls/vbs/tests/step4_if_fn_do.mal b/impls/vbs/tests/step4_if_fn_do.mal index 8697f6beec..79ba87478d 100644 --- a/impls/vbs/tests/step4_if_fn_do.mal +++ b/impls/vbs/tests/step4_if_fn_do.mal @@ -1,6 +1,18 @@ ((fn* [x] [x]) (list 1 2 3)) +;=>[(1 2 3)] + ((fn* [x] [x]) [1 2 3]) +;=>[[1 2 3]] + ((fn* [x] (list x)) (list 1 2 3)) +;=>((1 2 3)) + ((fn* [x] (list x)) [1 2 3]) +;=>([1 2 3]) + ((fn* [x] x) (list 1 2 3)) -((fn* [x] x) [1 2 3]) \ No newline at end of file +;=>(1 2 3) + +((fn* [x] x) [1 2 3]) +;=>[1 2 3] + diff --git a/impls/vbs/tests/step9_try.mal b/impls/vbs/tests/step9_try.mal index 4217ffb7ac..89597a14ce 100644 --- a/impls/vbs/tests/step9_try.mal +++ b/impls/vbs/tests/step9_try.mal @@ -1,4 +1,11 @@ (throw (list 1 2 3)) -(try* (throw {}) (catch* e (do (prn e) (throw e)))) -(try* (throw (list 1 2 3)) (catch* exc (do (prn "err:" exc) 7))) +;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*\(1 2 3\).* + +(try* (throw {}) (catch* e (do (throw e)))) +;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*{}.* + +(try* (throw (list 1 2 3)) (catch* exc (do 7))) +;=>7 + (try* (map throw (list "my err")) (catch* exc exc)) +;=>"my err" \ No newline at end of file From 88db809157db7e6688935b439391392bd5c68aca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 15:15:57 +0800 Subject: [PATCH 066/129] vbs: Merge pull request #7 from OldLiu001/cy20lin-fix-windows-runtest Cy20lin fix windows runtest From ff5893f346d663716735dce77f4a4f451708832d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 15:27:33 +0800 Subject: [PATCH 067/129] vbs: Removes the echos used by the debug github action --- .github/workflows/main.yml | 9 --------- 1 file changed, 9 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 9a49ff2b04..068e896ccf 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -159,25 +159,16 @@ jobs: - name: Step Tests shell: bash run: | - echo shell: bash, hello world from Step Tests - echo export ${{ matrix.IMPL }} - echo ./ci.sh test ${IMPL} export ${{ matrix.IMPL }} ./ci.sh test ${IMPL} - name: Regression Tests shell: bash run: | - echo shell: bash, hello world from Regression Tests - echo export ${{ matrix.IMPL }} - echo STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} export ${{ matrix.IMPL }} STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} - name: Performance Tests shell: bash run: | - echo shell: bash, hello world from Performance Tests - echo export ${{ matrix.IMPL }} - echo ./ci.sh perf ${IMPL} export ${{ matrix.IMPL }} ./ci.sh perf ${IMPL} - name: Archive logs and debug output From e18b7f74c31060efafa9b945ce12f156c609e863 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 15:27:39 +0800 Subject: [PATCH 068/129] vbs: step5 is too slow for vbs, skip it --- Makefile.impls | 1 + 1 file changed, 1 insertion(+) diff --git a/Makefile.impls b/Makefile.impls index aed43333d9..c386bc4ed2 100644 --- a/Makefile.impls +++ b/Makefile.impls @@ -53,6 +53,7 @@ step5_EXCLUDES += prolog # no iteration (but interpreter does TCO implicitl step5_EXCLUDES += sml # not implemented :( step5_EXCLUDES += $(if $(filter cpp,$(haxe_MODE)),haxe,) # cpp finishes 10,000, segfaults at 100,000 step5_EXCLUDES += xslt # iteration cannot be expressed +step5_EXCLUDES += vbs # to0 slow for 10,000 dist_EXCLUDES += mal # TODO: still need to implement dist From 8e97ceb3c23d9ae0bd56fbb070df670995089aa0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 15:35:52 +0800 Subject: [PATCH 069/129] vbs: add an run script for pass the step6's argv_test --- impls/vbs/run | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 impls/vbs/run diff --git a/impls/vbs/run b/impls/vbs/run new file mode 100644 index 0000000000..4d1d7d43b9 --- /dev/null +++ b/impls/vbs/run @@ -0,0 +1,2 @@ +#!/bin/bash +exec cscript -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" \ No newline at end of file From c09bbc83663f38285223012612889ebed90e6600 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 15:54:57 +0800 Subject: [PATCH 070/129] vbs: remove the restriction that the first argument to 'apply' must be a function. --- impls/vbs/core.vbs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index 5ec631ca81..cef8933dda 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -487,10 +487,10 @@ Function MApply(objArgs, objEnv) 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 + ' If objFn.IsSpecial Or objFn.IsMacro Then + ' Err.Raise vbObjectError, _ + ' "MApply", "Need a function." + ' End If Dim objAST Set objAST = NewMalList(Array(objFn)) From 17a2e4c3d06c4fd14889bbc4aede9ac6a31bcf34 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 8 Aug 2024 16:08:18 +0800 Subject: [PATCH 071/129] vbs: restores files that have been changed for debug --- IMPLS.yml | 245 ++++++++++++++++++++++++----------------------- Makefile.impls | 2 +- README.md | 2 +- get-ci-matrix.py | 1 - 4 files changed, 125 insertions(+), 125 deletions(-) diff --git a/IMPLS.yml b/IMPLS.yml index 89eee4dbd6..a679e379ae 100644 --- a/IMPLS.yml +++ b/IMPLS.yml @@ -1,124 +1,125 @@ IMPL: - - {IMPL: vbs, NO_DOCKER: 1, OS: windows} # place it first for quick feedback - # - {IMPL: ada} -# - {IMPL: ada.2} -# - {IMPL: awk} -# - {IMPL: bash, NO_SELF_HOST: 1} # step8 timeout -# - {IMPL: basic, basic_MODE: cbm, NO_SELF_HOST: 1} # step4 OOM -# - {IMPL: basic, basic_MODE: qbasic, NO_SELF_HOST: 1} # step4 OOM -# - {IMPL: bbc-basic} -# - {IMPL: c} -# - {IMPL: c.2} -# - {IMPL: cpp} -# - {IMPL: coffee} -# - {IMPL: cs} -# - {IMPL: chuck, NO_SELF_HOST_PERF: 1} # perf OOM -# - {IMPL: clojure, clojure_MODE: clj} -# - {IMPL: clojure, clojure_MODE: cljs} -# - {IMPL: common-lisp} -# - {IMPL: crystal} -# - {IMPL: d, d_MODE: gdc} -# - {IMPL: d, d_MODE: ldc2} -# - {IMPL: d, d_MODE: dmd} -# - {IMPL: dart} -# - {IMPL: elisp} -# - {IMPL: elixir} -# - {IMPL: elm} -# - {IMPL: erlang, NO_SELF_HOST: 1} # step8 OOM -# - {IMPL: es6} -# - {IMPL: factor} -# - {IMPL: fantom} -# - {IMPL: fennel} -# - {IMPL: forth} -# - {IMPL: fsharp} -# - {IMPL: go} -# - {IMPL: groovy} -# - {IMPL: gnu-smalltalk} -# - {IMPL: guile} -# - {IMPL: haskell} -# - {IMPL: haxe, haxe_MODE: neko} -# - {IMPL: haxe, haxe_MODE: python} -# - {IMPL: haxe, haxe_MODE: cpp, SLOW: 1} -# - {IMPL: haxe, haxe_MODE: js} -# - {IMPL: hy} -# - {IMPL: io, NO_SELF_HOST_PERF: 1} # perf OOM -# - {IMPL: janet} -# - {IMPL: java} -# - {IMPL: java-truffle} -# - {IMPL: jq} -# - {IMPL: js} -# - {IMPL: julia} -# - {IMPL: kotlin} -# - {IMPL: livescript} -# - {IMPL: logo} -# - {IMPL: lua} -# - {IMPL: make, NO_SELF_HOST: 1} # step4 timeout -# - {IMPL: mal, MAL_IMPL: js, BUILD_IMPL: js, NO_SELF_HOST: 1} -# - {IMPL: mal, MAL_IMPL: js-mal, BUILD_IMPL: js, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} -# - {IMPL: mal, MAL_IMPL: nim, BUILD_IMPL: nim, NO_SELF_HOST: 1} -# - {IMPL: mal, MAL_IMPL: nim-mal, BUILD_IMPL: nim, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} -# - {IMPL: matlab, NO_SELF_HOST_PERF: 1} # Octave, perf timeout -# - {IMPL: miniMAL, NO_SELF_HOST_PERF: 1, SLOW: 1} # perf timeout -# - {IMPL: nasm, NO_SELF_HOST_PERF: 1} # perf OOM -# - {IMPL: nim} -# - {IMPL: objpascal} -# - {IMPL: objc} -# - {IMPL: ocaml} -# - {IMPL: perl} -# - {IMPL: perl6} -# - {IMPL: php} -# - {IMPL: picolisp} -# - {IMPL: pike} -# - {IMPL: plpgsql, NO_SELF_HOST: 1, SLOW: 1} # step3 timeout -# # - {IMPL: plsql} -# - {IMPL: prolog} -# - {IMPL: ps} -# - {IMPL: powershell, NO_SELF_HOST_PERF: 1} -# - {IMPL: purs} -# - {IMPL: python, python_MODE: python2} -# - {IMPL: python, python_MODE: python3} -# - {IMPL: python.2} -# - {IMPL: r} -# - {IMPL: racket} -# - {IMPL: rexx} -# - {IMPL: rpython, SLOW: 1} -# - {IMPL: ruby} -# - {IMPL: ruby.2} -# - {IMPL: rust} -# - {IMPL: scala} -# - {IMPL: scheme, scheme_MODE: chibi} -# - {IMPL: scheme, scheme_MODE: kawa} -# - {IMPL: scheme, scheme_MODE: gauche} -# - {IMPL: scheme, scheme_MODE: chicken} -# - {IMPL: scheme, scheme_MODE: sagittarius} -# - {IMPL: scheme, scheme_MODE: cyclone} -# # - {IMPL: scheme, scheme_MODE: foment} -# - {IMPL: skew} -# - {IMPL: sml, sml_MODE: polyml} -# - {IMPL: sml, sml_MODE: mlton} -# - {IMPL: sml, sml_MODE: mosml} -# - {IMPL: tcl} -# - {IMPL: ts} -# - {IMPL: vala} -# - {IMPL: vb} -# - {IMPL: vhdl, NO_SELF_HOST_PERF: 1} # perf timeout -# - {IMPL: vimscript} -# # no self-host perf for wasm due to mac stack overflow -# - {IMPL: wasm, wasm_MODE: wasmtime, NO_SELF_HOST_PERF: 1, NO_PERF: 1} -# - {IMPL: wasm, wasm_MODE: wasmer, NO_SELF_HOST_PERF: 1, NO_PERF: 1} -# - {IMPL: wasm, wasm_MODE: lucet, NO_SELF_HOST_PERF: 1, NO_PERF: 1} -# #- {IMPL: wasm, wasm_MODE: wax, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions -# - {IMPL: wasm, wasm_MODE: node, NO_SELF_HOST_PERF: 1, NO_PERF: 1} -# #- {IMPL: wasm, wasm_MODE: warpy, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions -# #- {IMPL: wasm, wasm_MODE: wace_libc, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions -# - {IMPL: wren} -# - {IMPL: xslt} -# - {IMPL: yorick} -# - {IMPL: zig} + - {IMPL: ada} + - {IMPL: ada.2} + - {IMPL: awk} + - {IMPL: bash, NO_SELF_HOST: 1} # step8 timeout + - {IMPL: basic, basic_MODE: cbm, NO_SELF_HOST: 1} # step4 OOM + - {IMPL: basic, basic_MODE: qbasic, NO_SELF_HOST: 1} # step4 OOM + - {IMPL: bbc-basic} + - {IMPL: c} + - {IMPL: c.2} + - {IMPL: cpp} + - {IMPL: coffee} + - {IMPL: cs} + - {IMPL: chuck, NO_SELF_HOST_PERF: 1} # perf OOM + - {IMPL: clojure, clojure_MODE: clj} + - {IMPL: clojure, clojure_MODE: cljs} + - {IMPL: common-lisp} + - {IMPL: crystal} + - {IMPL: d, d_MODE: gdc} + - {IMPL: d, d_MODE: ldc2} + - {IMPL: d, d_MODE: dmd} + - {IMPL: dart} + - {IMPL: elisp} + - {IMPL: elixir} + - {IMPL: elm} + - {IMPL: erlang, NO_SELF_HOST: 1} # step8 OOM + - {IMPL: es6} + - {IMPL: factor} + - {IMPL: fantom} + - {IMPL: fennel} + - {IMPL: forth} + - {IMPL: fsharp} + - {IMPL: go} + - {IMPL: groovy} + - {IMPL: gnu-smalltalk} + - {IMPL: guile} + - {IMPL: haskell} + - {IMPL: haxe, haxe_MODE: neko} + - {IMPL: haxe, haxe_MODE: python} + - {IMPL: haxe, haxe_MODE: cpp, SLOW: 1} + - {IMPL: haxe, haxe_MODE: js} + - {IMPL: hy} + - {IMPL: io, NO_SELF_HOST_PERF: 1} # perf OOM + - {IMPL: janet} + - {IMPL: java} + - {IMPL: java-truffle} + - {IMPL: jq} + - {IMPL: js} + - {IMPL: julia} + - {IMPL: kotlin} + - {IMPL: livescript} + - {IMPL: logo} + - {IMPL: lua} + - {IMPL: make, NO_SELF_HOST: 1} # step4 timeout + - {IMPL: mal, MAL_IMPL: js, BUILD_IMPL: js, NO_SELF_HOST: 1} + - {IMPL: mal, MAL_IMPL: js-mal, BUILD_IMPL: js, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} + - {IMPL: mal, MAL_IMPL: nim, BUILD_IMPL: nim, NO_SELF_HOST: 1} + - {IMPL: mal, MAL_IMPL: nim-mal, BUILD_IMPL: nim, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} + - {IMPL: matlab, NO_SELF_HOST_PERF: 1} # Octave, perf timeout + - {IMPL: miniMAL, NO_SELF_HOST_PERF: 1, SLOW: 1} # perf timeout + - {IMPL: nasm, NO_SELF_HOST_PERF: 1} # perf OOM + - {IMPL: nim} + - {IMPL: objpascal} + - {IMPL: objc} + - {IMPL: ocaml} + - {IMPL: perl} + - {IMPL: perl6} + - {IMPL: php} + - {IMPL: picolisp} + - {IMPL: pike} + - {IMPL: plpgsql, NO_SELF_HOST: 1, SLOW: 1} # step3 timeout +# - {IMPL: plsql} + - {IMPL: prolog} + - {IMPL: ps} + - {IMPL: powershell, NO_SELF_HOST_PERF: 1} + - {IMPL: purs} + - {IMPL: python, python_MODE: python2} + - {IMPL: python, python_MODE: python3} + - {IMPL: python.2} + - {IMPL: r} + - {IMPL: racket} + - {IMPL: rexx} + - {IMPL: rpython, SLOW: 1} + - {IMPL: ruby} + - {IMPL: ruby.2} + - {IMPL: rust} + - {IMPL: scala} + - {IMPL: scheme, scheme_MODE: chibi} + - {IMPL: scheme, scheme_MODE: kawa} + - {IMPL: scheme, scheme_MODE: gauche} + - {IMPL: scheme, scheme_MODE: chicken} + - {IMPL: scheme, scheme_MODE: sagittarius} + - {IMPL: scheme, scheme_MODE: cyclone} +# - {IMPL: scheme, scheme_MODE: foment} + - {IMPL: skew} + - {IMPL: sml, sml_MODE: polyml} + - {IMPL: sml, sml_MODE: mlton} + - {IMPL: sml, sml_MODE: mosml} + - {IMPL: tcl} + - {IMPL: ts} + - {IMPL: vala} + - {IMPL: vb} + - {IMPL: vhdl, NO_SELF_HOST_PERF: 1} # perf timeout + - {IMPL: vimscript} + # no self-host perf for wasm due to mac stack overflow + - {IMPL: wasm, wasm_MODE: wasmtime, NO_SELF_HOST_PERF: 1, NO_PERF: 1} + - {IMPL: wasm, wasm_MODE: wasmer, NO_SELF_HOST_PERF: 1, NO_PERF: 1} + - {IMPL: wasm, wasm_MODE: lucet, NO_SELF_HOST_PERF: 1, NO_PERF: 1} + #- {IMPL: wasm, wasm_MODE: wax, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions + - {IMPL: wasm, wasm_MODE: node, NO_SELF_HOST_PERF: 1, NO_PERF: 1} + #- {IMPL: wasm, wasm_MODE: warpy, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions + #- {IMPL: wasm, wasm_MODE: wace_libc, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions + - {IMPL: wren} + - {IMPL: xslt} + - {IMPL: yorick} + - {IMPL: zig} -# # See .travis.yml (for older osx / xcode tests) -# # - {IMPL: objc, NO_DOCKER: 1, OS: xcode7}} -# # - {IMPL: swift, NO_DOCKER: 1, OS: xcode7.3}} -# # - {IMPL: swift3, NO_DOCKER: 1, OS: xcode8}} -# # - {IMPL: swift4, NO_DOCKER: 1, OS: xcode10}} - # - {IMPL: swift5, NO_DOCKER: 1, OS: macos} + # See .travis.yml (for older osx / xcode tests) +# - {IMPL: objc, NO_DOCKER: 1, OS: xcode7}} +# - {IMPL: swift, NO_DOCKER: 1, OS: xcode7.3}} +# - {IMPL: swift3, NO_DOCKER: 1, OS: xcode8}} +# - {IMPL: swift4, NO_DOCKER: 1, OS: xcode10}} + - {IMPL: swift5, NO_DOCKER: 1, OS: macos} + + - {IMPL: vbs, NO_DOCKER: 1, OS: windows} diff --git a/Makefile.impls b/Makefile.impls index c386bc4ed2..c53cd41f3e 100644 --- a/Makefile.impls +++ b/Makefile.impls @@ -53,7 +53,7 @@ step5_EXCLUDES += prolog # no iteration (but interpreter does TCO implicitl step5_EXCLUDES += sml # not implemented :( step5_EXCLUDES += $(if $(filter cpp,$(haxe_MODE)),haxe,) # cpp finishes 10,000, segfaults at 100,000 step5_EXCLUDES += xslt # iteration cannot be expressed -step5_EXCLUDES += vbs # to0 slow for 10,000 +step5_EXCLUDES += vbs # too slow for 10,000 dist_EXCLUDES += mal # TODO: still need to implement dist diff --git a/README.md b/README.md index cf1b76f3d9..cd8f2c3bf4 100644 --- a/README.md +++ b/README.md @@ -135,7 +135,7 @@ FAQ](docs/FAQ.md) where I attempt to answer some common questions. | [VHDL](#vhdl) | [Dov Murik](https://github.com/dubek) | | [Vimscript](#vimscript) | [Dov Murik](https://github.com/dubek) | | [Visual Basic.NET](#visual-basicnet) | [Joel Martin](https://github.com/kanaka) | -| [Visual Basic Script](#visual-basic-script) | [Baichao Liu](https://github.com/OldLiu001) | +| [Visual Basic Script](#visual-basic-script) | [刘百超](https://github.com/OldLiu001) | | [WebAssembly](#webassembly-wasm) (wasm) | [Joel Martin](https://github.com/kanaka) | | [Wren](#wren) | [Dov Murik](https://github.com/dubek) | | [XSLT](#xslt) | [Ali MohammadPur](https://github.com/alimpfard) | diff --git a/get-ci-matrix.py b/get-ci-matrix.py index 49d99ca01f..451728d1e1 100755 --- a/get-ci-matrix.py +++ b/get-ci-matrix.py @@ -34,7 +34,6 @@ def impl_text(impl): # If we have non-implementation code changes then we will add all # implementations to the test matrix -do_full = True if OVERRIDE_IMPLS: run_impls = OVERRIDE_IMPLS if 'all' in OVERRIDE_IMPLS: From 0bdae3d6c59d7e292959ddb9dd9a64bf342a92f2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Fri, 9 Aug 2024 10:41:49 +0800 Subject: [PATCH 072/129] vbs: restore `runtest.py` to unupdated version --- runtest.py | 222 +++++----------- runtest_fixed_by_@cy20lin&me.py | 448 ++++++++++++++++++++++++++++++++ 2 files changed, 511 insertions(+), 159 deletions(-) create mode 100644 runtest_fixed_by_@cy20lin&me.py diff --git a/runtest.py b/runtest.py index ada6a54231..9ee4ce3575 100755 --- a/runtest.py +++ b/runtest.py @@ -1,21 +1,17 @@ #!/usr/bin/env python + from __future__ import print_function import os, sys, re import argparse, time import signal, atexit + from subprocess import Popen, STDOUT, PIPE +from select import select -IS_PY_3 = sys.version_info[0] == 3 +# Pseudo-TTY and terminal manipulation +import pty, array, fcntl, termios -if os.name == 'posix': - from select import select -else: - if IS_PY_3: - import threading, queue - from subprocess import TimeoutExpired - else: - import threading - import Queue as queue +IS_PY_3 = sys.version_info[0] == 3 debug_file = None log_file = None @@ -87,165 +83,82 @@ def __init__(self, args, no_pty=False, line_break="\n"): env['TERM'] = 'dumb' env['INPUTRC'] = '/dev/null' env['PERL_RL'] = 'false' - if os.name == 'posix': - if no_pty: - self.p = Popen(args, bufsize=0, - stdin=PIPE, stdout=PIPE, stderr=STDOUT, - preexec_fn=os.setsid, - env=env) - self.stdin = self.p.stdin - self.stdout = self.p.stdout - else: - # Pseudo-TTY and terminal manipulation - import pty, array, fcntl, termios - - # provide tty to get 'interactive' readline to work - master, slave = pty.openpty() - - # Set terminal size large so that readline will not send - # ANSI/VT escape codes when the lines are long. - buf = array.array('h', [100, 200, 0, 0]) - fcntl.ioctl(master, termios.TIOCSWINSZ, buf, True) - - self.p = Popen(args, bufsize=0, - stdin=slave, stdout=slave, stderr=STDOUT, - preexec_fn=os.setsid, - env=env) - # Now close slave so that we will get an exception from - # read when the child exits early - # http://stackoverflow.com/questions/11165521 - os.close(slave) - self.stdin = os.fdopen(master, 'r+b', 0) - self.stdout = self.stdin - elif os.name == 'nt': - if no_pty: - from subprocess import CREATE_NEW_PROCESS_GROUP - - # replace args's forward slashes & append ext name - args[0] = args[0].replace('/', '\\') + '.cmd' - - self.p = Popen(args, bufsize=0, - stdin=PIPE, stdout=PIPE, stderr=STDOUT, - creationflags=CREATE_NEW_PROCESS_GROUP, - env=env) - self.stdin = self.p.stdin - self.stdout = self.p.stdout - else: - raise ValueError('pty not supported on os.name="{}"'.format(os.name)) + print(args) + args = ['bash'] + args + if no_pty: + self.p = Popen(args, bufsize=0, + stdin=PIPE, stdout=PIPE, stderr=STDOUT, + preexec_fn=os.setsid, + env=env) + self.stdin = self.p.stdin + self.stdout = self.p.stdout else: - if no_pty: - self.p = Popen(args, bufsize=0, - stdin=PIPE, stdout=PIPE, stderr=STDOUT, - env=env) - self.stdin = self.p.stdin - self.stdout = self.p.stdout - else: - raise ValueError('pty not supported on os.name="{}"'.format(os.name)) + # provide tty to get 'interactive' readline to work + master, slave = pty.openpty() + + # Set terminal size large so that readline will not send + # ANSI/VT escape codes when the lines are long. + buf = array.array('h', [100, 200, 0, 0]) + fcntl.ioctl(master, termios.TIOCSWINSZ, buf, True) + + self.p = Popen(args, bufsize=0, + stdin=slave, stdout=slave, stderr=STDOUT, + preexec_fn=os.setsid, + env=env) + # Now close slave so that we will get an exception from + # read when the child exits early + # http://stackoverflow.com/questions/11165521 + os.close(slave) + self.stdin = os.fdopen(master, 'r+b', 0) + self.stdout = self.stdin #print "started" self.buf = "" self.last_prompt = "" + self.line_break = line_break - if os.name == 'posix': - self.q = None - self.t = None - else: - self.q = queue.Queue() - self.t = threading.Thread(target=self._reader, args=()) - self.t.daemon = True - self.t.start() - - def _reader(self): - try: - f = self.stdout - ok = True - while ok: - try: - new_data = f.read(1) - if len(new_data) == 0: # EOF - ok = False - except Exception as e: - # catch the read exception and send it to queue - ok = False - new_data = e - self.q.put(new_data) - except: - pass - - def read_to_prompt(self, prompts, timeout, search_prefix=''): + def read_to_prompt(self, prompts, timeout): end_time = time.time() + timeout - while True: - current_timeout = max(end_time - time.time(), 0.) - if current_timeout == 0.: - break - if os.name == 'posix': - [outs,_,_] = select([self.stdout], [], [], 1) - if self.stdout not in outs: - continue + while time.time() < end_time: + [outs,_,_] = select([self.stdout], [], [], 1) + if self.stdout in outs: new_data = self.stdout.read(1) - - else: - try: - new_data = self.q.get(timeout=current_timeout) - except queue.Empty: - break - if isinstance(new_data, Exception): - raise new_data - if len(new_data) == 0: # EOF - break - new_data = new_data.decode("latin1") if IS_PY_3 else new_data - #print("new_data: '%s'" % new_data) - debug(new_data) - # Perform newline cleanup - self.buf += new_data.replace("\r", "") - for prompt in prompts: - regexp = re.compile(prompt) - match = regexp.search(search_prefix + self.buf) - if match: - start = match.start() - len(search_prefix) - end = match.end() - len(search_prefix) - buf = self.buf[0:start] - self.buf = self.buf[end:] - self.last_prompt = prompt - return buf - # MAYBE we should distinguish EOF from TIMEOUT, - # return None for both cases currently + new_data = new_data.decode("latin1") if IS_PY_3 else new_data + #print("new_data: '%s'" % new_data) + debug(new_data) + # Perform newline cleanup + self.buf += new_data.replace("\r", "") + for prompt in prompts: + regexp = re.compile(prompt) + match = regexp.search(self.buf) + if match: + end = match.end() + buf = self.buf[0:match.start()] + self.buf = self.buf[end:] + self.last_prompt = prompt + return buf return None def writeline(self, str): def _to_bytes(s): return bytes(s, "latin1") if IS_PY_3 else s - if os.name == 'posix': - self.stdin.write(_to_bytes(str.replace('\r', '\x16\r') + self.line_break)) - else: - self.stdin.write(_to_bytes(str + self.line_break)) - + + self.stdin.write(_to_bytes(str.replace('\r', '\x16\r') + self.line_break)) + def cleanup(self): #print "cleaning up" if self.p: try: - if os.name == 'posix': - os.killpg(self.p.pid, signal.SIGTERM) - elif os.name == 'nt': - self.p.send_signal(signal.CTRL_BREAK_EVENT) - else: - self.p.terminate() - if IS_PY_3: - try: - self.p.communicate(timeout=1.0) - except TimeoutExpired: - self.p.kill() + os.killpg(self.p.pid, signal.SIGTERM) except OSError: pass self.p = None - self.stdin = None - self.stdout = None class TestReader: def __init__(self, test_file): self.line_num = 0 - f = open(test_file) + f = open(test_file, newline='') if IS_PY_3 else open(test_file) self.data = f.read().split('\n') self.soft = False self.deferrable = False @@ -356,14 +269,6 @@ def assert_prompt(runner, prompts, timeout): class TestTimeout(Exception): pass -def has_any_match(expects, res): - success = False - for expect in expects: - success = re.search(expect, res, re.S) - if success: - break - return success - while t.next(): if args.deferrable == False and t.deferrable: log(t.deferrable) @@ -384,16 +289,14 @@ def has_any_match(expects, res): # The repeated form is to get around an occasional OS X issue # where the form is repeated. # https://github.com/kanaka/mal/issues/30 - expects = ["%s%s" % (t.out, re.escape(t.ret)), # for Windows, WSL - ".*%s%s%s" % (sep, t.out, re.escape(t.ret)), # for Linux, OS X - ".*%s.*%s%s%s" % (sep, sep, t.out, re.escape(t.ret))] # for OS X + expects = [".*%s%s%s" % (sep, t.out, re.escape(t.ret)), + ".*%s.*%s%s%s" % (sep, sep, t.out, re.escape(t.ret))] r.writeline(t.form) try: test_cnt += 1 - # Search with prepending prefix '\n' for avoiding hangs on Windows - res = r.read_to_prompt(['\r\n[^\s()<>]+> ', '\n[^\s()<>]+> '], - timeout=args.test_timeout, search_prefix='\n') + res = r.read_to_prompt(['\r\n[^\\s()<>]+> ', '\n[^\\s()<>]+> '], + timeout=args.test_timeout) #print "%s,%s,%s" % (idx, repr(p.before), repr(p.after)) if (res == None): log(" -> TIMEOUT (line %d)" % t.line_num) @@ -401,7 +304,8 @@ def has_any_match(expects, res): elif (t.ret == "" and t.out == ""): log(" -> SUCCESS (result ignored)") pass_cnt += 1 - elif has_any_match(expects, res): + elif (re.search(expects[0], res, re.S) or + re.search(expects[1], res, re.S)): log(" -> SUCCESS") pass_cnt += 1 else: diff --git a/runtest_fixed_by_@cy20lin&me.py b/runtest_fixed_by_@cy20lin&me.py new file mode 100644 index 0000000000..ada6a54231 --- /dev/null +++ b/runtest_fixed_by_@cy20lin&me.py @@ -0,0 +1,448 @@ +#!/usr/bin/env python +from __future__ import print_function +import os, sys, re +import argparse, time +import signal, atexit +from subprocess import Popen, STDOUT, PIPE + +IS_PY_3 = sys.version_info[0] == 3 + +if os.name == 'posix': + from select import select +else: + if IS_PY_3: + import threading, queue + from subprocess import TimeoutExpired + else: + import threading + import Queue as queue + +debug_file = None +log_file = None + +def debug(data): + if debug_file: + debug_file.write(data) + debug_file.flush() + +def log(data, end='\n'): + if log_file: + log_file.write(data + end) + log_file.flush() + print(data, end=end) + sys.stdout.flush() + +sep = "\n" +rundir = None + +parser = argparse.ArgumentParser( + description="Run a test file against a Mal implementation") +parser.add_argument('--rundir', + help="change to the directory before running tests") +parser.add_argument('--start-timeout', default=10, type=int, + help="default timeout for initial prompt") +parser.add_argument('--test-timeout', default=20, type=int, + help="default timeout for each individual test action") +parser.add_argument('--pre-eval', default=None, type=str, + help="Mal code to evaluate prior to running the test") +parser.add_argument('--no-pty', action='store_true', + help="Use direct pipes instead of pseudo-tty") +parser.add_argument('--log-file', type=str, + help="Write messages to the named file in addition the screen") +parser.add_argument('--debug-file', type=str, + help="Write all test interaction the named file") +parser.add_argument('--hard', action='store_true', + help="Turn soft tests (soft, deferrable, optional) into hard failures") + +# Control whether deferrable and optional tests are executed +parser.add_argument('--deferrable', dest='deferrable', action='store_true', + help="Enable deferrable tests that follow a ';>>> deferrable=True'") +parser.add_argument('--no-deferrable', dest='deferrable', action='store_false', + help="Disable deferrable tests that follow a ';>>> deferrable=True'") +parser.set_defaults(deferrable=True) +parser.add_argument('--optional', dest='optional', action='store_true', + help="Enable optional tests that follow a ';>>> optional=True'") +parser.add_argument('--no-optional', dest='optional', action='store_false', + help="Disable optional tests that follow a ';>>> optional=True'") +parser.set_defaults(optional=True) + +parser.add_argument('test_file', type=str, + help="a test file formatted as with mal test data") +parser.add_argument('mal_cmd', nargs="*", + help="Mal implementation command line. Use '--' to " + "specify a Mal command line with dashed options.") +parser.add_argument('--crlf', dest='crlf', action='store_true', + help="Write \\r\\n instead of \\n to the input") + +class Runner(): + def __init__(self, args, no_pty=False, line_break="\n"): + #print "args: %s" % repr(args) + self.no_pty = no_pty + + # Cleanup child process on exit + atexit.register(self.cleanup) + + self.p = None + env = os.environ + env['TERM'] = 'dumb' + env['INPUTRC'] = '/dev/null' + env['PERL_RL'] = 'false' + if os.name == 'posix': + if no_pty: + self.p = Popen(args, bufsize=0, + stdin=PIPE, stdout=PIPE, stderr=STDOUT, + preexec_fn=os.setsid, + env=env) + self.stdin = self.p.stdin + self.stdout = self.p.stdout + else: + # Pseudo-TTY and terminal manipulation + import pty, array, fcntl, termios + + # provide tty to get 'interactive' readline to work + master, slave = pty.openpty() + + # Set terminal size large so that readline will not send + # ANSI/VT escape codes when the lines are long. + buf = array.array('h', [100, 200, 0, 0]) + fcntl.ioctl(master, termios.TIOCSWINSZ, buf, True) + + self.p = Popen(args, bufsize=0, + stdin=slave, stdout=slave, stderr=STDOUT, + preexec_fn=os.setsid, + env=env) + # Now close slave so that we will get an exception from + # read when the child exits early + # http://stackoverflow.com/questions/11165521 + os.close(slave) + self.stdin = os.fdopen(master, 'r+b', 0) + self.stdout = self.stdin + elif os.name == 'nt': + if no_pty: + from subprocess import CREATE_NEW_PROCESS_GROUP + + # replace args's forward slashes & append ext name + args[0] = args[0].replace('/', '\\') + '.cmd' + + self.p = Popen(args, bufsize=0, + stdin=PIPE, stdout=PIPE, stderr=STDOUT, + creationflags=CREATE_NEW_PROCESS_GROUP, + env=env) + self.stdin = self.p.stdin + self.stdout = self.p.stdout + else: + raise ValueError('pty not supported on os.name="{}"'.format(os.name)) + else: + if no_pty: + self.p = Popen(args, bufsize=0, + stdin=PIPE, stdout=PIPE, stderr=STDOUT, + env=env) + self.stdin = self.p.stdin + self.stdout = self.p.stdout + else: + raise ValueError('pty not supported on os.name="{}"'.format(os.name)) + + #print "started" + self.buf = "" + self.last_prompt = "" + self.line_break = line_break + + if os.name == 'posix': + self.q = None + self.t = None + else: + self.q = queue.Queue() + self.t = threading.Thread(target=self._reader, args=()) + self.t.daemon = True + self.t.start() + + def _reader(self): + try: + f = self.stdout + ok = True + while ok: + try: + new_data = f.read(1) + if len(new_data) == 0: # EOF + ok = False + except Exception as e: + # catch the read exception and send it to queue + ok = False + new_data = e + self.q.put(new_data) + except: + pass + + def read_to_prompt(self, prompts, timeout, search_prefix=''): + end_time = time.time() + timeout + while True: + current_timeout = max(end_time - time.time(), 0.) + if current_timeout == 0.: + break + if os.name == 'posix': + [outs,_,_] = select([self.stdout], [], [], 1) + if self.stdout not in outs: + continue + new_data = self.stdout.read(1) + + else: + try: + new_data = self.q.get(timeout=current_timeout) + except queue.Empty: + break + if isinstance(new_data, Exception): + raise new_data + if len(new_data) == 0: # EOF + break + new_data = new_data.decode("latin1") if IS_PY_3 else new_data + #print("new_data: '%s'" % new_data) + debug(new_data) + # Perform newline cleanup + self.buf += new_data.replace("\r", "") + for prompt in prompts: + regexp = re.compile(prompt) + match = regexp.search(search_prefix + self.buf) + if match: + start = match.start() - len(search_prefix) + end = match.end() - len(search_prefix) + buf = self.buf[0:start] + self.buf = self.buf[end:] + self.last_prompt = prompt + return buf + # MAYBE we should distinguish EOF from TIMEOUT, + # return None for both cases currently + return None + + def writeline(self, str): + def _to_bytes(s): + return bytes(s, "latin1") if IS_PY_3 else s + if os.name == 'posix': + self.stdin.write(_to_bytes(str.replace('\r', '\x16\r') + self.line_break)) + else: + self.stdin.write(_to_bytes(str + self.line_break)) + + def cleanup(self): + #print "cleaning up" + if self.p: + try: + if os.name == 'posix': + os.killpg(self.p.pid, signal.SIGTERM) + elif os.name == 'nt': + self.p.send_signal(signal.CTRL_BREAK_EVENT) + else: + self.p.terminate() + if IS_PY_3: + try: + self.p.communicate(timeout=1.0) + except TimeoutExpired: + self.p.kill() + except OSError: + pass + self.p = None + self.stdin = None + self.stdout = None + +class TestReader: + def __init__(self, test_file): + self.line_num = 0 + f = open(test_file) + self.data = f.read().split('\n') + self.soft = False + self.deferrable = False + self.optional = False + + def next(self): + self.msg = None + self.form = None + self.out = "" + self.ret = None + + while self.data: + self.line_num += 1 + line = self.data.pop(0) + if re.match(r"^\s*$", line): # blank line + continue + elif line[0:3] == ";;;": # ignore comment + continue + elif line[0:2] == ";;": # output comment + self.msg = line[3:] + return True + elif line[0:5] == ";>>> ": # settings/commands + settings = {} + exec(line[5:], {}, settings) + if 'soft' in settings: + self.soft = settings['soft'] + if 'deferrable' in settings and settings['deferrable']: + self.deferrable = "\nSkipping deferrable and optional tests" + return True + if 'optional' in settings and settings['optional']: + self.optional = "\nSkipping optional tests" + return True + continue + elif line[0:1] == ";": # unexpected comment + raise Exception("Test data error at line %d:\n%s" % (self.line_num, line)) + self.form = line # the line is a form to send + + # Now find the output and return value + while self.data: + line = self.data[0] + if line[0:3] == ";=>": + self.ret = line[3:] + self.line_num += 1 + self.data.pop(0) + break + elif line[0:2] == ";/": + self.out = self.out + line[2:] + sep + self.line_num += 1 + self.data.pop(0) + else: + self.ret = "" + break + if self.ret != None: break + + if self.out[-1:] == sep and not self.ret: + # If there is no return value, output should not end in + # separator + self.out = self.out[0:-1] + return self.form + +args = parser.parse_args(sys.argv[1:]) +# Workaround argparse issue with two '--' on command line +if sys.argv.count('--') > 0: + args.mal_cmd = sys.argv[sys.argv.index('--')+1:] + +if args.rundir: os.chdir(args.rundir) + +if args.log_file: log_file = open(args.log_file, "a") +if args.debug_file: debug_file = open(args.debug_file, "a") + +r = Runner(args.mal_cmd, no_pty=args.no_pty, line_break="\r\n" if args.crlf else "\n") +t = TestReader(args.test_file) + + +def assert_prompt(runner, prompts, timeout): + # Wait for the initial prompt + header = runner.read_to_prompt(prompts, timeout=timeout) + if not header == None: + if header: + log("Started with:\n%s" % header) + else: + log("Did not receive one of following prompt(s): %s" % repr(prompts)) + log(" Got : %s" % repr(r.buf)) + sys.exit(1) + + +# Wait for the initial prompt +try: + assert_prompt(r, ['[^\\s()<>]+> '], args.start_timeout) +except: + _, exc, _ = sys.exc_info() + log("\nException: %s" % repr(exc)) + log("Output before exception:\n%s" % r.buf) + sys.exit(1) + +# Send the pre-eval code if any +if args.pre_eval: + sys.stdout.write("RUNNING pre-eval: %s" % args.pre_eval) + r.writeline(args.pre_eval) + assert_prompt(r, ['[^\\s()<>]+> '], args.test_timeout) + +test_cnt = 0 +pass_cnt = 0 +fail_cnt = 0 +soft_fail_cnt = 0 +failures = [] + +class TestTimeout(Exception): + pass + +def has_any_match(expects, res): + success = False + for expect in expects: + success = re.search(expect, res, re.S) + if success: + break + return success + +while t.next(): + if args.deferrable == False and t.deferrable: + log(t.deferrable) + break + + if args.optional == False and t.optional: + log(t.optional) + break + + if t.msg != None: + log(t.msg) + continue + + if t.form == None: continue + + log("TEST: %s -> [%s,%s]" % (repr(t.form), repr(t.out), t.ret), end='') + + # The repeated form is to get around an occasional OS X issue + # where the form is repeated. + # https://github.com/kanaka/mal/issues/30 + expects = ["%s%s" % (t.out, re.escape(t.ret)), # for Windows, WSL + ".*%s%s%s" % (sep, t.out, re.escape(t.ret)), # for Linux, OS X + ".*%s.*%s%s%s" % (sep, sep, t.out, re.escape(t.ret))] # for OS X + + r.writeline(t.form) + try: + test_cnt += 1 + # Search with prepending prefix '\n' for avoiding hangs on Windows + res = r.read_to_prompt(['\r\n[^\s()<>]+> ', '\n[^\s()<>]+> '], + timeout=args.test_timeout, search_prefix='\n') + #print "%s,%s,%s" % (idx, repr(p.before), repr(p.after)) + if (res == None): + log(" -> TIMEOUT (line %d)" % t.line_num) + raise TestTimeout("TIMEOUT (line %d)" % t.line_num) + elif (t.ret == "" and t.out == ""): + log(" -> SUCCESS (result ignored)") + pass_cnt += 1 + elif has_any_match(expects, res): + log(" -> SUCCESS") + pass_cnt += 1 + else: + if t.soft and not args.hard: + log(" -> SOFT FAIL (line %d):" % t.line_num) + soft_fail_cnt += 1 + fail_type = "SOFT " + else: + log(" -> FAIL (line %d):" % t.line_num) + fail_cnt += 1 + fail_type = "" + log(" Expected : %s" % repr(expects[0])) + log(" Got : %s" % repr(res)) + failed_test = """%sFAILED TEST (line %d): %s -> [%s,%s]: + Expected : %s + Got : %s""" % (fail_type, t.line_num, t.form, repr(t.out), + t.ret, repr(expects[0]), repr(res)) + failures.append(failed_test) + except: + _, exc, _ = sys.exc_info() + log("\nException: %s" % repr(exc)) + log("Output before exception:\n%s" % r.buf) + sys.exit(1) + +if len(failures) > 0: + log("\nFAILURES:") + for f in failures: + log(f) + +results = """ +TEST RESULTS (for %s): + %3d: soft failing tests + %3d: failing tests + %3d: passing tests + %3d: total tests +""" % (args.test_file, soft_fail_cnt, fail_cnt, + pass_cnt, test_cnt) +log(results) + +debug("\n") # add some separate to debug log + +if fail_cnt > 0: + sys.exit(1) +sys.exit(0) From 99f6341493e6c37ee12ca646becbacf96e243b99 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Fri, 9 Aug 2024 10:43:51 +0800 Subject: [PATCH 073/129] vbs: change the `repeated form` from issue 30 for testing --- runtest.py | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/runtest.py b/runtest.py index 9ee4ce3575..82aabb41a3 100755 --- a/runtest.py +++ b/runtest.py @@ -289,8 +289,9 @@ class TestTimeout(Exception): # The repeated form is to get around an occasional OS X issue # where the form is repeated. # https://github.com/kanaka/mal/issues/30 - expects = [".*%s%s%s" % (sep, t.out, re.escape(t.ret)), - ".*%s.*%s%s%s" % (sep, sep, t.out, re.escape(t.ret))] + expects = ["%s%s" % (t.out, re.escape(t.ret)), # for Windows, WSL + ".*%s%s%s" % (sep, t.out, re.escape(t.ret)), # for Linux, OS X + ".*%s.*%s%s%s" % (sep, sep, t.out, re.escape(t.ret))] # for OS X r.writeline(t.form) try: From e2bfd73b454b6730c689e110a320e7ea5ce499f8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Fri, 9 Aug 2024 11:10:23 +0800 Subject: [PATCH 074/129] vbs: rename runtest for Better distinguish --- ...d_by_@cy20lin&me.py => runtest_fixed_by_@cy20lin&@OldLiu001.py | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename runtest_fixed_by_@cy20lin&me.py => runtest_fixed_by_@cy20lin&@OldLiu001.py (100%) diff --git a/runtest_fixed_by_@cy20lin&me.py b/runtest_fixed_by_@cy20lin&@OldLiu001.py similarity index 100% rename from runtest_fixed_by_@cy20lin&me.py rename to runtest_fixed_by_@cy20lin&@OldLiu001.py From bd1505ab89b17b7f0f2a902a0da85ffa64e3524a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Fri, 9 Aug 2024 11:16:35 +0800 Subject: [PATCH 075/129] vbs: remove print & 'bash' + args --- runtest.py | 2 -- 1 file changed, 2 deletions(-) diff --git a/runtest.py b/runtest.py index 82aabb41a3..34186f21d7 100755 --- a/runtest.py +++ b/runtest.py @@ -83,8 +83,6 @@ def __init__(self, args, no_pty=False, line_break="\n"): env['TERM'] = 'dumb' env['INPUTRC'] = '/dev/null' env['PERL_RL'] = 'false' - print(args) - args = ['bash'] + args if no_pty: self.p = Popen(args, bufsize=0, stdin=PIPE, stdout=PIPE, stderr=STDOUT, From d14a2dd52b4139d4d5aa3f0dc555c56ab6f94ac2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Fri, 9 Aug 2024 12:04:50 +0800 Subject: [PATCH 076/129] vbs: restore runtest.py to updated version --- runtest.py | 215 ++++++++---- runtest_fixed_by_@cy20lin&@OldLiu001.py | 448 ------------------------ 2 files changed, 156 insertions(+), 507 deletions(-) delete mode 100644 runtest_fixed_by_@cy20lin&@OldLiu001.py diff --git a/runtest.py b/runtest.py index 34186f21d7..ada6a54231 100755 --- a/runtest.py +++ b/runtest.py @@ -1,18 +1,22 @@ #!/usr/bin/env python - from __future__ import print_function import os, sys, re import argparse, time import signal, atexit - from subprocess import Popen, STDOUT, PIPE -from select import select - -# Pseudo-TTY and terminal manipulation -import pty, array, fcntl, termios IS_PY_3 = sys.version_info[0] == 3 +if os.name == 'posix': + from select import select +else: + if IS_PY_3: + import threading, queue + from subprocess import TimeoutExpired + else: + import threading + import Queue as queue + debug_file = None log_file = None @@ -83,80 +87,165 @@ def __init__(self, args, no_pty=False, line_break="\n"): env['TERM'] = 'dumb' env['INPUTRC'] = '/dev/null' env['PERL_RL'] = 'false' - if no_pty: - self.p = Popen(args, bufsize=0, - stdin=PIPE, stdout=PIPE, stderr=STDOUT, - preexec_fn=os.setsid, - env=env) - self.stdin = self.p.stdin - self.stdout = self.p.stdout + if os.name == 'posix': + if no_pty: + self.p = Popen(args, bufsize=0, + stdin=PIPE, stdout=PIPE, stderr=STDOUT, + preexec_fn=os.setsid, + env=env) + self.stdin = self.p.stdin + self.stdout = self.p.stdout + else: + # Pseudo-TTY and terminal manipulation + import pty, array, fcntl, termios + + # provide tty to get 'interactive' readline to work + master, slave = pty.openpty() + + # Set terminal size large so that readline will not send + # ANSI/VT escape codes when the lines are long. + buf = array.array('h', [100, 200, 0, 0]) + fcntl.ioctl(master, termios.TIOCSWINSZ, buf, True) + + self.p = Popen(args, bufsize=0, + stdin=slave, stdout=slave, stderr=STDOUT, + preexec_fn=os.setsid, + env=env) + # Now close slave so that we will get an exception from + # read when the child exits early + # http://stackoverflow.com/questions/11165521 + os.close(slave) + self.stdin = os.fdopen(master, 'r+b', 0) + self.stdout = self.stdin + elif os.name == 'nt': + if no_pty: + from subprocess import CREATE_NEW_PROCESS_GROUP + + # replace args's forward slashes & append ext name + args[0] = args[0].replace('/', '\\') + '.cmd' + + self.p = Popen(args, bufsize=0, + stdin=PIPE, stdout=PIPE, stderr=STDOUT, + creationflags=CREATE_NEW_PROCESS_GROUP, + env=env) + self.stdin = self.p.stdin + self.stdout = self.p.stdout + else: + raise ValueError('pty not supported on os.name="{}"'.format(os.name)) else: - # provide tty to get 'interactive' readline to work - master, slave = pty.openpty() - - # Set terminal size large so that readline will not send - # ANSI/VT escape codes when the lines are long. - buf = array.array('h', [100, 200, 0, 0]) - fcntl.ioctl(master, termios.TIOCSWINSZ, buf, True) - - self.p = Popen(args, bufsize=0, - stdin=slave, stdout=slave, stderr=STDOUT, - preexec_fn=os.setsid, - env=env) - # Now close slave so that we will get an exception from - # read when the child exits early - # http://stackoverflow.com/questions/11165521 - os.close(slave) - self.stdin = os.fdopen(master, 'r+b', 0) - self.stdout = self.stdin + if no_pty: + self.p = Popen(args, bufsize=0, + stdin=PIPE, stdout=PIPE, stderr=STDOUT, + env=env) + self.stdin = self.p.stdin + self.stdout = self.p.stdout + else: + raise ValueError('pty not supported on os.name="{}"'.format(os.name)) #print "started" self.buf = "" self.last_prompt = "" - self.line_break = line_break - def read_to_prompt(self, prompts, timeout): + if os.name == 'posix': + self.q = None + self.t = None + else: + self.q = queue.Queue() + self.t = threading.Thread(target=self._reader, args=()) + self.t.daemon = True + self.t.start() + + def _reader(self): + try: + f = self.stdout + ok = True + while ok: + try: + new_data = f.read(1) + if len(new_data) == 0: # EOF + ok = False + except Exception as e: + # catch the read exception and send it to queue + ok = False + new_data = e + self.q.put(new_data) + except: + pass + + def read_to_prompt(self, prompts, timeout, search_prefix=''): end_time = time.time() + timeout - while time.time() < end_time: - [outs,_,_] = select([self.stdout], [], [], 1) - if self.stdout in outs: + while True: + current_timeout = max(end_time - time.time(), 0.) + if current_timeout == 0.: + break + if os.name == 'posix': + [outs,_,_] = select([self.stdout], [], [], 1) + if self.stdout not in outs: + continue new_data = self.stdout.read(1) - new_data = new_data.decode("latin1") if IS_PY_3 else new_data - #print("new_data: '%s'" % new_data) - debug(new_data) - # Perform newline cleanup - self.buf += new_data.replace("\r", "") - for prompt in prompts: - regexp = re.compile(prompt) - match = regexp.search(self.buf) - if match: - end = match.end() - buf = self.buf[0:match.start()] - self.buf = self.buf[end:] - self.last_prompt = prompt - return buf + + else: + try: + new_data = self.q.get(timeout=current_timeout) + except queue.Empty: + break + if isinstance(new_data, Exception): + raise new_data + if len(new_data) == 0: # EOF + break + new_data = new_data.decode("latin1") if IS_PY_3 else new_data + #print("new_data: '%s'" % new_data) + debug(new_data) + # Perform newline cleanup + self.buf += new_data.replace("\r", "") + for prompt in prompts: + regexp = re.compile(prompt) + match = regexp.search(search_prefix + self.buf) + if match: + start = match.start() - len(search_prefix) + end = match.end() - len(search_prefix) + buf = self.buf[0:start] + self.buf = self.buf[end:] + self.last_prompt = prompt + return buf + # MAYBE we should distinguish EOF from TIMEOUT, + # return None for both cases currently return None def writeline(self, str): def _to_bytes(s): return bytes(s, "latin1") if IS_PY_3 else s - - self.stdin.write(_to_bytes(str.replace('\r', '\x16\r') + self.line_break)) - + if os.name == 'posix': + self.stdin.write(_to_bytes(str.replace('\r', '\x16\r') + self.line_break)) + else: + self.stdin.write(_to_bytes(str + self.line_break)) + def cleanup(self): #print "cleaning up" if self.p: try: - os.killpg(self.p.pid, signal.SIGTERM) + if os.name == 'posix': + os.killpg(self.p.pid, signal.SIGTERM) + elif os.name == 'nt': + self.p.send_signal(signal.CTRL_BREAK_EVENT) + else: + self.p.terminate() + if IS_PY_3: + try: + self.p.communicate(timeout=1.0) + except TimeoutExpired: + self.p.kill() except OSError: pass self.p = None + self.stdin = None + self.stdout = None class TestReader: def __init__(self, test_file): self.line_num = 0 - f = open(test_file, newline='') if IS_PY_3 else open(test_file) + f = open(test_file) self.data = f.read().split('\n') self.soft = False self.deferrable = False @@ -267,6 +356,14 @@ def assert_prompt(runner, prompts, timeout): class TestTimeout(Exception): pass +def has_any_match(expects, res): + success = False + for expect in expects: + success = re.search(expect, res, re.S) + if success: + break + return success + while t.next(): if args.deferrable == False and t.deferrable: log(t.deferrable) @@ -294,8 +391,9 @@ class TestTimeout(Exception): r.writeline(t.form) try: test_cnt += 1 - res = r.read_to_prompt(['\r\n[^\\s()<>]+> ', '\n[^\\s()<>]+> '], - timeout=args.test_timeout) + # Search with prepending prefix '\n' for avoiding hangs on Windows + res = r.read_to_prompt(['\r\n[^\s()<>]+> ', '\n[^\s()<>]+> '], + timeout=args.test_timeout, search_prefix='\n') #print "%s,%s,%s" % (idx, repr(p.before), repr(p.after)) if (res == None): log(" -> TIMEOUT (line %d)" % t.line_num) @@ -303,8 +401,7 @@ class TestTimeout(Exception): elif (t.ret == "" and t.out == ""): log(" -> SUCCESS (result ignored)") pass_cnt += 1 - elif (re.search(expects[0], res, re.S) or - re.search(expects[1], res, re.S)): + elif has_any_match(expects, res): log(" -> SUCCESS") pass_cnt += 1 else: diff --git a/runtest_fixed_by_@cy20lin&@OldLiu001.py b/runtest_fixed_by_@cy20lin&@OldLiu001.py deleted file mode 100644 index ada6a54231..0000000000 --- a/runtest_fixed_by_@cy20lin&@OldLiu001.py +++ /dev/null @@ -1,448 +0,0 @@ -#!/usr/bin/env python -from __future__ import print_function -import os, sys, re -import argparse, time -import signal, atexit -from subprocess import Popen, STDOUT, PIPE - -IS_PY_3 = sys.version_info[0] == 3 - -if os.name == 'posix': - from select import select -else: - if IS_PY_3: - import threading, queue - from subprocess import TimeoutExpired - else: - import threading - import Queue as queue - -debug_file = None -log_file = None - -def debug(data): - if debug_file: - debug_file.write(data) - debug_file.flush() - -def log(data, end='\n'): - if log_file: - log_file.write(data + end) - log_file.flush() - print(data, end=end) - sys.stdout.flush() - -sep = "\n" -rundir = None - -parser = argparse.ArgumentParser( - description="Run a test file against a Mal implementation") -parser.add_argument('--rundir', - help="change to the directory before running tests") -parser.add_argument('--start-timeout', default=10, type=int, - help="default timeout for initial prompt") -parser.add_argument('--test-timeout', default=20, type=int, - help="default timeout for each individual test action") -parser.add_argument('--pre-eval', default=None, type=str, - help="Mal code to evaluate prior to running the test") -parser.add_argument('--no-pty', action='store_true', - help="Use direct pipes instead of pseudo-tty") -parser.add_argument('--log-file', type=str, - help="Write messages to the named file in addition the screen") -parser.add_argument('--debug-file', type=str, - help="Write all test interaction the named file") -parser.add_argument('--hard', action='store_true', - help="Turn soft tests (soft, deferrable, optional) into hard failures") - -# Control whether deferrable and optional tests are executed -parser.add_argument('--deferrable', dest='deferrable', action='store_true', - help="Enable deferrable tests that follow a ';>>> deferrable=True'") -parser.add_argument('--no-deferrable', dest='deferrable', action='store_false', - help="Disable deferrable tests that follow a ';>>> deferrable=True'") -parser.set_defaults(deferrable=True) -parser.add_argument('--optional', dest='optional', action='store_true', - help="Enable optional tests that follow a ';>>> optional=True'") -parser.add_argument('--no-optional', dest='optional', action='store_false', - help="Disable optional tests that follow a ';>>> optional=True'") -parser.set_defaults(optional=True) - -parser.add_argument('test_file', type=str, - help="a test file formatted as with mal test data") -parser.add_argument('mal_cmd', nargs="*", - help="Mal implementation command line. Use '--' to " - "specify a Mal command line with dashed options.") -parser.add_argument('--crlf', dest='crlf', action='store_true', - help="Write \\r\\n instead of \\n to the input") - -class Runner(): - def __init__(self, args, no_pty=False, line_break="\n"): - #print "args: %s" % repr(args) - self.no_pty = no_pty - - # Cleanup child process on exit - atexit.register(self.cleanup) - - self.p = None - env = os.environ - env['TERM'] = 'dumb' - env['INPUTRC'] = '/dev/null' - env['PERL_RL'] = 'false' - if os.name == 'posix': - if no_pty: - self.p = Popen(args, bufsize=0, - stdin=PIPE, stdout=PIPE, stderr=STDOUT, - preexec_fn=os.setsid, - env=env) - self.stdin = self.p.stdin - self.stdout = self.p.stdout - else: - # Pseudo-TTY and terminal manipulation - import pty, array, fcntl, termios - - # provide tty to get 'interactive' readline to work - master, slave = pty.openpty() - - # Set terminal size large so that readline will not send - # ANSI/VT escape codes when the lines are long. - buf = array.array('h', [100, 200, 0, 0]) - fcntl.ioctl(master, termios.TIOCSWINSZ, buf, True) - - self.p = Popen(args, bufsize=0, - stdin=slave, stdout=slave, stderr=STDOUT, - preexec_fn=os.setsid, - env=env) - # Now close slave so that we will get an exception from - # read when the child exits early - # http://stackoverflow.com/questions/11165521 - os.close(slave) - self.stdin = os.fdopen(master, 'r+b', 0) - self.stdout = self.stdin - elif os.name == 'nt': - if no_pty: - from subprocess import CREATE_NEW_PROCESS_GROUP - - # replace args's forward slashes & append ext name - args[0] = args[0].replace('/', '\\') + '.cmd' - - self.p = Popen(args, bufsize=0, - stdin=PIPE, stdout=PIPE, stderr=STDOUT, - creationflags=CREATE_NEW_PROCESS_GROUP, - env=env) - self.stdin = self.p.stdin - self.stdout = self.p.stdout - else: - raise ValueError('pty not supported on os.name="{}"'.format(os.name)) - else: - if no_pty: - self.p = Popen(args, bufsize=0, - stdin=PIPE, stdout=PIPE, stderr=STDOUT, - env=env) - self.stdin = self.p.stdin - self.stdout = self.p.stdout - else: - raise ValueError('pty not supported on os.name="{}"'.format(os.name)) - - #print "started" - self.buf = "" - self.last_prompt = "" - self.line_break = line_break - - if os.name == 'posix': - self.q = None - self.t = None - else: - self.q = queue.Queue() - self.t = threading.Thread(target=self._reader, args=()) - self.t.daemon = True - self.t.start() - - def _reader(self): - try: - f = self.stdout - ok = True - while ok: - try: - new_data = f.read(1) - if len(new_data) == 0: # EOF - ok = False - except Exception as e: - # catch the read exception and send it to queue - ok = False - new_data = e - self.q.put(new_data) - except: - pass - - def read_to_prompt(self, prompts, timeout, search_prefix=''): - end_time = time.time() + timeout - while True: - current_timeout = max(end_time - time.time(), 0.) - if current_timeout == 0.: - break - if os.name == 'posix': - [outs,_,_] = select([self.stdout], [], [], 1) - if self.stdout not in outs: - continue - new_data = self.stdout.read(1) - - else: - try: - new_data = self.q.get(timeout=current_timeout) - except queue.Empty: - break - if isinstance(new_data, Exception): - raise new_data - if len(new_data) == 0: # EOF - break - new_data = new_data.decode("latin1") if IS_PY_3 else new_data - #print("new_data: '%s'" % new_data) - debug(new_data) - # Perform newline cleanup - self.buf += new_data.replace("\r", "") - for prompt in prompts: - regexp = re.compile(prompt) - match = regexp.search(search_prefix + self.buf) - if match: - start = match.start() - len(search_prefix) - end = match.end() - len(search_prefix) - buf = self.buf[0:start] - self.buf = self.buf[end:] - self.last_prompt = prompt - return buf - # MAYBE we should distinguish EOF from TIMEOUT, - # return None for both cases currently - return None - - def writeline(self, str): - def _to_bytes(s): - return bytes(s, "latin1") if IS_PY_3 else s - if os.name == 'posix': - self.stdin.write(_to_bytes(str.replace('\r', '\x16\r') + self.line_break)) - else: - self.stdin.write(_to_bytes(str + self.line_break)) - - def cleanup(self): - #print "cleaning up" - if self.p: - try: - if os.name == 'posix': - os.killpg(self.p.pid, signal.SIGTERM) - elif os.name == 'nt': - self.p.send_signal(signal.CTRL_BREAK_EVENT) - else: - self.p.terminate() - if IS_PY_3: - try: - self.p.communicate(timeout=1.0) - except TimeoutExpired: - self.p.kill() - except OSError: - pass - self.p = None - self.stdin = None - self.stdout = None - -class TestReader: - def __init__(self, test_file): - self.line_num = 0 - f = open(test_file) - self.data = f.read().split('\n') - self.soft = False - self.deferrable = False - self.optional = False - - def next(self): - self.msg = None - self.form = None - self.out = "" - self.ret = None - - while self.data: - self.line_num += 1 - line = self.data.pop(0) - if re.match(r"^\s*$", line): # blank line - continue - elif line[0:3] == ";;;": # ignore comment - continue - elif line[0:2] == ";;": # output comment - self.msg = line[3:] - return True - elif line[0:5] == ";>>> ": # settings/commands - settings = {} - exec(line[5:], {}, settings) - if 'soft' in settings: - self.soft = settings['soft'] - if 'deferrable' in settings and settings['deferrable']: - self.deferrable = "\nSkipping deferrable and optional tests" - return True - if 'optional' in settings and settings['optional']: - self.optional = "\nSkipping optional tests" - return True - continue - elif line[0:1] == ";": # unexpected comment - raise Exception("Test data error at line %d:\n%s" % (self.line_num, line)) - self.form = line # the line is a form to send - - # Now find the output and return value - while self.data: - line = self.data[0] - if line[0:3] == ";=>": - self.ret = line[3:] - self.line_num += 1 - self.data.pop(0) - break - elif line[0:2] == ";/": - self.out = self.out + line[2:] + sep - self.line_num += 1 - self.data.pop(0) - else: - self.ret = "" - break - if self.ret != None: break - - if self.out[-1:] == sep and not self.ret: - # If there is no return value, output should not end in - # separator - self.out = self.out[0:-1] - return self.form - -args = parser.parse_args(sys.argv[1:]) -# Workaround argparse issue with two '--' on command line -if sys.argv.count('--') > 0: - args.mal_cmd = sys.argv[sys.argv.index('--')+1:] - -if args.rundir: os.chdir(args.rundir) - -if args.log_file: log_file = open(args.log_file, "a") -if args.debug_file: debug_file = open(args.debug_file, "a") - -r = Runner(args.mal_cmd, no_pty=args.no_pty, line_break="\r\n" if args.crlf else "\n") -t = TestReader(args.test_file) - - -def assert_prompt(runner, prompts, timeout): - # Wait for the initial prompt - header = runner.read_to_prompt(prompts, timeout=timeout) - if not header == None: - if header: - log("Started with:\n%s" % header) - else: - log("Did not receive one of following prompt(s): %s" % repr(prompts)) - log(" Got : %s" % repr(r.buf)) - sys.exit(1) - - -# Wait for the initial prompt -try: - assert_prompt(r, ['[^\\s()<>]+> '], args.start_timeout) -except: - _, exc, _ = sys.exc_info() - log("\nException: %s" % repr(exc)) - log("Output before exception:\n%s" % r.buf) - sys.exit(1) - -# Send the pre-eval code if any -if args.pre_eval: - sys.stdout.write("RUNNING pre-eval: %s" % args.pre_eval) - r.writeline(args.pre_eval) - assert_prompt(r, ['[^\\s()<>]+> '], args.test_timeout) - -test_cnt = 0 -pass_cnt = 0 -fail_cnt = 0 -soft_fail_cnt = 0 -failures = [] - -class TestTimeout(Exception): - pass - -def has_any_match(expects, res): - success = False - for expect in expects: - success = re.search(expect, res, re.S) - if success: - break - return success - -while t.next(): - if args.deferrable == False and t.deferrable: - log(t.deferrable) - break - - if args.optional == False and t.optional: - log(t.optional) - break - - if t.msg != None: - log(t.msg) - continue - - if t.form == None: continue - - log("TEST: %s -> [%s,%s]" % (repr(t.form), repr(t.out), t.ret), end='') - - # The repeated form is to get around an occasional OS X issue - # where the form is repeated. - # https://github.com/kanaka/mal/issues/30 - expects = ["%s%s" % (t.out, re.escape(t.ret)), # for Windows, WSL - ".*%s%s%s" % (sep, t.out, re.escape(t.ret)), # for Linux, OS X - ".*%s.*%s%s%s" % (sep, sep, t.out, re.escape(t.ret))] # for OS X - - r.writeline(t.form) - try: - test_cnt += 1 - # Search with prepending prefix '\n' for avoiding hangs on Windows - res = r.read_to_prompt(['\r\n[^\s()<>]+> ', '\n[^\s()<>]+> '], - timeout=args.test_timeout, search_prefix='\n') - #print "%s,%s,%s" % (idx, repr(p.before), repr(p.after)) - if (res == None): - log(" -> TIMEOUT (line %d)" % t.line_num) - raise TestTimeout("TIMEOUT (line %d)" % t.line_num) - elif (t.ret == "" and t.out == ""): - log(" -> SUCCESS (result ignored)") - pass_cnt += 1 - elif has_any_match(expects, res): - log(" -> SUCCESS") - pass_cnt += 1 - else: - if t.soft and not args.hard: - log(" -> SOFT FAIL (line %d):" % t.line_num) - soft_fail_cnt += 1 - fail_type = "SOFT " - else: - log(" -> FAIL (line %d):" % t.line_num) - fail_cnt += 1 - fail_type = "" - log(" Expected : %s" % repr(expects[0])) - log(" Got : %s" % repr(res)) - failed_test = """%sFAILED TEST (line %d): %s -> [%s,%s]: - Expected : %s - Got : %s""" % (fail_type, t.line_num, t.form, repr(t.out), - t.ret, repr(expects[0]), repr(res)) - failures.append(failed_test) - except: - _, exc, _ = sys.exc_info() - log("\nException: %s" % repr(exc)) - log("Output before exception:\n%s" % r.buf) - sys.exit(1) - -if len(failures) > 0: - log("\nFAILURES:") - for f in failures: - log(f) - -results = """ -TEST RESULTS (for %s): - %3d: soft failing tests - %3d: failing tests - %3d: passing tests - %3d: total tests -""" % (args.test_file, soft_fail_cnt, fail_cnt, - pass_cnt, test_cnt) -log(results) - -debug("\n") # add some separate to debug log - -if fail_cnt > 0: - sys.exit(1) -sys.exit(0) From 8e9752068081a8b422ac77c110d3656c0c951a7a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Fri, 9 Aug 2024 12:16:16 +0800 Subject: [PATCH 077/129] vbs: Simplify run.cmd --- impls/vbs/run.cmd | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/impls/vbs/run.cmd b/impls/vbs/run.cmd index d48387b3b2..64a5dad4f2 100644 --- a/impls/vbs/run.cmd +++ b/impls/vbs/run.cmd @@ -1,5 +1,2 @@ -@echo off & setlocal -if not defined STEP set STEP=stepA_mal - -set "SCRIPT=%~dp0\%STEP%.vbs" -cscript //nologo "%SCRIPT%" %* \ No newline at end of file +@setlocal & @if not defined STEP set STEP=stepA_mal +@cscript -nologo "%~dp0\%STEP%.vbs" %* \ No newline at end of file From 827cbd78f8bdb1fd4b49ff90cf85c3ebd5669738 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Fri, 9 Aug 2024 19:12:09 +0800 Subject: [PATCH 078/129] vbs: Merge branch 'kanaka:master' into master --- .github/workflows/main.yml | 16 +- IMPLS.yml | 2 +- Makefile.impls | 8 +- README.md | 7 +- impls/make/core.mk | 323 +++++++++++---------------------- impls/make/env.mk | 42 ++--- impls/make/printer.mk | 36 ++-- impls/make/readline.mk | 15 +- impls/make/step2_eval.mk | 94 ++++++---- impls/make/step3_env.mk | 130 +++++++------ impls/make/step4_if_fn_do.mk | 166 +++++++++-------- impls/make/step6_file.mk | 183 ++++++++++--------- impls/make/step7_quote.mk | 234 +++++++++++++----------- impls/make/step8_macros.mk | 248 ++++++++++++++----------- impls/make/step9_try.mk | 279 +++++++++++++++------------- impls/make/stepA_mal.mk | 293 +++++++++++++++++------------- impls/make/util.mk | 104 ++++++----- impls/python/env.py | 4 - impls/python/reader.py | 23 ++- impls/python/step3_env.py | 31 ++-- impls/python/step4_if_fn_do.py | 39 ++-- impls/python/step5_tco.py | 52 ++++-- impls/python/step6_file.py | 58 +++--- impls/python/step7_quote.py | 81 +++++---- impls/python/step8_macros.py | 90 +++++---- impls/python/step9_try.py | 106 ++++++----- impls/python/stepA_mal.py | 107 ++++++----- 27 files changed, 1490 insertions(+), 1281 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 068e896ccf..ea7dd61e3f 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -83,13 +83,7 @@ jobs: if: ${{ github.event.inputs.self-hosted == 'yes' }} run: | export ${{ matrix.IMPL }} - if [ "${NO_SELF_HOST}" ]; then - echo "Skipping self-host for ${IMPL} due to NO_SELF_HOST variable" - else - DO_SELF_HOST=1 ./ci.sh test ${IMPL} - # Check that self-hosted mode really ran - [ "`grep -a "mal-user>" test-mal-*${IMPL}.debug | wc -l`" -gt 800 ] - fi + DO_SELF_HOST=1 ./ci.sh test ${IMPL} - name: Archive logs and debug output uses: actions/upload-artifact@v4 with: @@ -127,13 +121,7 @@ jobs: if: ${{ github.event.inputs.self-hosted == 'yes' }} run: | export ${{ matrix.IMPL }} - if [ "${NO_SELF_HOST}" ]; then - echo "Skipping self-host for ${IMPL} due to NO_SELF_HOST variable" - else - DO_SELF_HOST=1 ./ci.sh test ${IMPL} - # Check that self-hosted mode really ran - [ "`grep -a "mal-user>" test-mal-*${IMPL}.debug | wc -l`" -gt 800 ] - fi + DO_SELF_HOST=1 ./ci.sh test ${IMPL} - name: Archive logs and debug output uses: actions/upload-artifact@v4 with: diff --git a/IMPLS.yml b/IMPLS.yml index a679e379ae..02a8056ce8 100644 --- a/IMPLS.yml +++ b/IMPLS.yml @@ -48,6 +48,7 @@ IMPL: - {IMPL: js} - {IMPL: julia} - {IMPL: kotlin} + - {IMPL: latex3, NO_PERF: 1, NO_SELF_HOST: 1, SLOW: 1} - {IMPL: livescript} - {IMPL: logo} - {IMPL: lua} @@ -105,7 +106,6 @@ IMPL: # no self-host perf for wasm due to mac stack overflow - {IMPL: wasm, wasm_MODE: wasmtime, NO_SELF_HOST_PERF: 1, NO_PERF: 1} - {IMPL: wasm, wasm_MODE: wasmer, NO_SELF_HOST_PERF: 1, NO_PERF: 1} - - {IMPL: wasm, wasm_MODE: lucet, NO_SELF_HOST_PERF: 1, NO_PERF: 1} #- {IMPL: wasm, wasm_MODE: wax, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions - {IMPL: wasm, wasm_MODE: node, NO_SELF_HOST_PERF: 1, NO_PERF: 1} #- {IMPL: wasm, wasm_MODE: warpy, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions diff --git a/Makefile.impls b/Makefile.impls index c53cd41f3e..32fe439ca6 100644 --- a/Makefile.impls +++ b/Makefile.impls @@ -26,7 +26,7 @@ python_MODE = python scheme_MODE = chibi # sml (polyml, mlton, mosml) sml_MODE = polyml -# wasmtime wasmer lucet wax node warpy wace_libc +# wasmtime wasmer wax node warpy wace_libc direct js wace_fooboot wasm_MODE = wasmtime @@ -36,13 +36,14 @@ wasm_MODE = wasmtime IMPLS = ada ada.2 awk bash basic bbc-basic c c.2 chuck clojure coffee common-lisp cpp crystal cs d dart \ elisp elixir elm erlang es6 factor fantom fennel forth fsharp go groovy gnu-smalltalk \ - guile haskell haxe hy io janet java java-truffle js jq julia kotlin livescript logo lua make mal \ + guile haskell haxe hy io janet java java-truffle js jq julia kotlin latex3 livescript logo lua make mal \ matlab miniMAL nasm nim objc objpascal ocaml perl perl6 php picolisp pike plpgsql \ plsql powershell prolog ps purs python python.2 r racket rexx rpython ruby ruby.2 rust scala scheme skew sml \ swift swift3 swift4 swift5 tcl ts vala vb vbs vhdl vimscript wasm wren yorick xslt zig step5_EXCLUDES += bash # never completes at 10,000 step5_EXCLUDES += basic # too slow, and limited to ints of 2^16 +step5_EXCLUDES += latex3 # no iteration, limited native stack step5_EXCLUDES += make # no TCO capability (iteration or recursion) step5_EXCLUDES += mal # host impl dependent step5_EXCLUDES += matlab # never completes at 10,000 @@ -147,6 +148,7 @@ js_STEP_TO_PROG = impls/js/$($(1)).js jq_STEP_PROG = impls/jq/$($(1)).jq julia_STEP_TO_PROG = impls/julia/$($(1)).jl kotlin_STEP_TO_PROG = impls/kotlin/$($(1)).jar +latex3_STEP_TO_PROG = impls/latex3/$($(1)).tex livescript_STEP_TO_PROG = impls/livescript/$($(1)).js logo_STEP_TO_PROG = impls/logo/$($(1)).lg lua_STEP_TO_PROG = impls/lua/$($(1)).lua @@ -194,7 +196,7 @@ vb_STEP_TO_PROG = impls/vb/$($(1)).exe vbs_STEP_TO_PROG = impls/vbs/$($(1)).vbs vhdl_STEP_TO_PROG = impls/vhdl/$($(1)) vimscript_STEP_TO_PROG = impls/vimscript/$($(1)).vim -wasm_STEP_TO_PROG = impls/wasm/$($(1)).$(if $(filter lucet,$(wasm_MODE)),so,wasm) +wasm_STEP_TO_PROG = impls/wasm/$($(1)).wasm wren_STEP_TO_PROG = impls/wren/$($(1)).wren yorick_STEP_TO_PROG = impls/yorick/$($(1)).i xslt_STEP_TO_PROG = impls/xslt/$($(1)) diff --git a/README.md b/README.md index cd8f2c3bf4..9642157638 100644 --- a/README.md +++ b/README.md @@ -30,10 +30,9 @@ The make-a-lisp steps are: Each make-a-lisp step has an associated architectural diagram. That elements that are new for that step are highlighted in red. -Here is the final architecture once [step A](process/guide.md#stepA) -is complete: +Here is the final diagram for [step A](process/guide.md#stepA): -![stepA_mal architecture](process/steps.png) +![stepA_mal architecture](process/stepA_mal.png) If you are interested in creating a mal implementation (or just interested in using mal for something) you are welcome to to join our @@ -42,7 +41,7 @@ process guide](process/guide.md) there is also a [mal/make-a-lisp FAQ](docs/FAQ.md) where I attempt to answer some common questions. -**3. Mal is implemented in 88 languages (94 different implementations and 115 runtime modes)** +**3. Mal is implemented in 87 languages (93 different implementations and 114 runtime modes)** | Language | Creator | | -------- | ------- | diff --git a/impls/make/core.mk b/impls/make/core.mk index 5e88f7b44f..1442f049dd 100644 --- a/impls/make/core.mk +++ b/impls/make/core.mk @@ -13,292 +13,189 @@ include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk -# Errors/Exceptions -throw = $(eval __ERROR := $(1)) - - # General functions -# Return the type of the object (or "make" if it's not a object -obj_type = $(call _string,$(call _obj_type,$(1))) - -equal? = $(if $(call _equal?,$(word 1,$(1)),$(word 2,$(1))),$(__true),$(__false)) +$(encoded_equal) = $(if $(call _equal?,$(firstword $1),$(lastword $1)),$(__true),$(__false)) # Scalar functions -nil? = $(if $(call _nil?,$(1)),$(__true),$(__false)) -true? = $(if $(call _true?,$(1)),$(__true),$(__false)) -false? = $(if $(call _false?,$(1)),$(__true),$(__false)) +nil? = $(if $(_nil?),$(__true),$(__false)) +true? = $(if $(_true?),$(__true),$(__false)) +false? = $(if $(_false?),$(__true),$(__false)) # Symbol functions -symbol = $(call _symbol,$(call str_decode,$($(1)_value))) -symbol? = $(if $(call _symbol?,$(1)),$(__true),$(__false)) +symbol = $(call _symbol,$(_string_val)) +symbol? = $(if $(_symbol?),$(__true),$(__false)) # Keyword functions -keyword = $(if $(_keyword?),$(1),$(call _keyword,$(call str_decode,$($(1)_value)))) -keyword? = $(if $(call _keyword?,$(1)),$(__true),$(__false)) +keyword = $(if $(_keyword?),$1,$(call _keyword,$(_string_val))) +keyword? = $(if $(_keyword?),$(__true),$(__false)) # Number functions -number? = $(if $(call _number?,$(1)),$(__true),$(__false)) - -number_lt = $(if $(call int_lt_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) -number_lte = $(if $(call int_lte_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) -number_gt = $(if $(call int_gt_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) -number_gte = $(if $(call int_gte_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) - -number_plus = $(call _pnumber,$(call int_add_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) -number_subtract = $(call _pnumber,$(call int_sub_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) -number_multiply = $(call _pnumber,$(call int_mult_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) -number_divide = $(call _pnumber,$(call int_div_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) - -time_ms = $(call _number,$(shell echo $$(date +%s%3N))) +number? = $(if $(_number?),$(__true),$(__false)) + +define < +$(if $(call int_lt,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ + ,$(__true),$(__false)) +endef +define <$(encoded_equal) +$(if $(call int_lte,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ + ,$(__true),$(__false)) +endef +define > +$(if $(call int_gt,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ + ,$(__true),$(__false)) +endef +define >$(encoded_equal) +$(if $(call int_gte,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ + ,$(__true),$(__false)) +endef + ++ = $(call _number,$(call int_add,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) +- = $(call _number,$(call int_sub,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) +* = $(call _number,$(call int_mult,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) +/ = $(call _number,$(call int_div,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) + +time-ms = $(call _number,$(shell date +%s%3N)) # String functions -string? = $(if $(call _string?,$(1)),$(if $(call _keyword?,$(1)),$(__false),$(__true)),$(__false)) +string? = $(if $(_string?),$(__true),$(__false)) -pr_str = $(call _string,$(call _pr_str_mult,$(1),yes, )) -str = $(call _string,$(call _pr_str_mult,$(1),,)) -prn = $(info $(call _pr_str_mult,$(1),yes, )) -println = $(info $(subst \n,$(NEWLINE),$(call _pr_str_mult,$(1),, ))) +pr-str = $(call _string,$(call _pr_str_mult,$1,yes,$(_SP))) +str = $(call _string,$(_pr_str_mult)) +prn = $(__nil)$(call print,$(call _pr_str_mult,$1,yes,$(_SP))) +println = $(__nil)$(call print,$(call _pr_str_mult,$1,,$(_SP))) -readline= $(foreach res,$(call _string,$(call READLINE,"$(call str_decode,$($(1)_value))")),$(if $(READLINE_EOF),$(eval READLINE_EOF :=)$(__nil),$(res))) -read_str= $(call READ_STR,$(1)) -slurp = $(call _string,$(call _read_file,$(call str_decode,$($(1)_value)))) - -subs = $(strip \ - $(foreach start,$(call int_add,1,$(call int_decode,$($(word 2,$(1))_value))),\ - $(foreach end,$(if $(3),$(call int_decode,$($(3)_value)),$(words $($(word 1,$(1))_value))),\ - $(call _string,$(wordlist $(start),$(end),$($(word 1,$(1))_value)))))) +readline = $(or $(foreach res,$(call READLINE,$(_string_val))\ + ,$(call _string,$(res:ok=)))\ + ,$(__nil)) +read-string = $(call READ_STR,$(_string_val)) +slurp = $(call _string,$(call _read_file,$(_string_val))) # Function functions -fn? = $(if $(call _function?,$(1)),$(if $(_macro_$(1)),$(__false),$(__true)),$(__false)) -macro? = $(if $(_macro_$(1)),$(__true),$(__false)) +fn? = $(if $(_fn?),$(__true),$(__false)) +macro? = $(if $(_macro?),$(__true),$(__false)) # List functions -list? = $(if $(call _list?,$(1)),$(__true),$(__false)) +list? = $(if $(_list?),$(__true),$(__false)) # Vector functions -vector? = $(if $(call _vector?,$(1)),$(__true),$(__false)) +vector? = $(if $(_vector?),$(__true),$(__false)) -vec = $(if $(_list?),$(call _vector,$($1_value)),$(if $(_vector?),$1,$(call _error,vec: called on non-sequence))) +vec = $(if $(_list?)\ + ,$(call vector,$(_seq_vals))$(rem \ +),$(if $(_vector?)\ + ,$1$(rem \ +),$(call _error,vec$(encoded_colon)$(_SP)called$(_SP)on$(_SP)non-sequence))) # Hash map (associative array) functions -hash_map? = $(if $(call _hash_map?,$(1)),$(__true),$(__false)) +hash-map = $(call _map_new,,$1) +map? = $(if $(_hash_map?),$(__true),$(__false)) # set a key/value in a copy of the hash map -assoc = $(word 1,\ - $(foreach hm,$(call _clone_obj,$(word 1,$(1))),\ - $(hm) \ - $(call _assoc_seq!,$(hm),$(wordlist 2,$(words $(1)),$(1))))) +assoc = $(call _map_new,$(firstword $1),$(_rest)) # unset keys in a copy of the hash map -# TODO: this could be made more efficient by copying only the -# keys that not being removed. -dissoc = $(word 1,\ - $(foreach hm,$(call _clone_obj,$(word 1,$(1))),\ - $(hm) \ - $(call _dissoc_seq!,$(hm),$(wordlist 2,$(words $(1)),$(1))))) - -keys = $(foreach new_list,$(call _list),$(new_list)$(eval $(new_list)_value := $(foreach v,$(call __get_obj_values,$(1)),$(foreach vval,$(word 4,$(subst _, ,$(v))),$(if $(filter $(__keyword)%,$(vval)),$(call _keyword,$(patsubst $(__keyword)%,%,$(vval))),$(call _string,$(vval))))))) +dissoc = $(call _map_new,$(firstword $1),,$(_rest)) -vals = $(foreach new_list,$(call _list),$(new_list)$(eval $(new_list)_value := $(foreach v,$(call __get_obj_values,$(1)),$($(v))))) +keys = $(call list,$(_keys)) -# Hash map and vector functions +vals = $(call list,$(foreach k,$(_keys),$(call _get,$1,$k))) # retrieve the value of a string key object from the hash map, or -# retrive a vector by number object index -get = $(strip \ - $(if $(call _nil?,$(word 1,$(1))),\ - $(__nil),\ - $(if $(call _hash_map?,$(word 1,$(1))),\ - $(call _get,$(word 1,$(1)),$(call str_decode,$($(word 2,$(1))_value))),\ - $(call _get,$(word 1,$(1)),$(call int_decode,$($(word 2,$(1))_value)))))) +# return nil if the key is not found. +get = $(or $(call _get,$(firstword $1),$(lastword $1)),$(__nil)) -contains? = $(if $(call _contains?,$(word 1,$(1)),$(call str_decode,$($(word 2,$(1))_value))),$(__true),$(__false)) +contains? = $(if $(call _get,$(firstword $1),$(lastword $1)),$(__true),$(__false)) # sequence operations -sequential? = $(if $(call _sequential?,$(1)),$(__true),$(__false)) - -cons = $(word 1,$(foreach new_list,$(call _list),$(new_list) $(eval $(new_list)_value := $(strip $(word 1,$(1)) $(call __get_obj_values,$(word 2,$(1))))))) +sequential? = $(if $(_sequential?),$(__true),$(__false)) -concat = $(word 1,$(foreach new_list,$(call _list),$(new_list) $(eval $(new_list)_value := $(strip $(foreach lst,$1,$(call __get_obj_values,$(lst))))))) +# Strip in case seq_vals is empty. +cons = $(call list,$(strip $(firstword $1) $(call _seq_vals,$(lastword $1)))) -nth = $(strip \ - $(if $(call int_lt,$($(word 2,$(1))_value),$(call int_encode,$(call _count,$(word 1,$(1))))),\ - $(word $(call int_add,1,$(call int_decode,$($(word 2,$(1))_value))),$($(word 1,$(1))_value)),\ - $(call _error,nth: index out of range))) +# Strip in case foreach introduces a space after an empty argument. +concat = $(call list,$(strip $(foreach l,$1,$(call _seq_vals,$l)))) -sfirst = $(word 1,$($(1)_value)) +nth = $(or $(word $(call int_add,1,$(call _number_val,$(lastword $1))),\ + $(call _seq_vals,$(firstword $1)))\ + ,$(call _error,nth: index out of range)) -slast = $(word $(words $($(1)_value)),$($(1)_value)) +first = $(or $(if $(_sequential?),$(firstword $(_seq_vals))),$(__nil)) -empty? = $(if $(_empty?),$(__true),$(__false)) +empty? = $(if $(_seq_vals),$(__false),$(__true)) -count = $(call _number,$(call _count,$(1))) +count = $(call _number,$(words $(if $(_sequential?),$(_seq_vals)))) # Creates a new vector/list of the everything after but the first # element -srest = $(word 1,$(foreach new_list,$(call _list),\ - $(new_list) \ - $(eval $(new_list)_value := $(wordlist 2,$(words $($(1)_value)),$($(1)_value))))) +rest = $(call list,$(if $(_sequential?),$(call _rest,$(_seq_vals)))) # Takes a space separated arguments and invokes the first argument # (function object) using the remaining arguments. -sapply = $(call $(word 1,$(1))_value,$(strip \ - $(wordlist 2,$(call int_sub,$(words $(1)),1),$(1)) \ - $($(word $(words $(1)),$(1))_value))) +# Strip in case wordlist or _seq_vals is empty. +apply = $(call _apply,$(firstword $1),$(strip \ + $(wordlist 2,$(call int_sub,$(words $1),1),$1) \ + $(call _seq_vals,$(lastword $1)))) # Map a function object over a list object -smap = $(strip\ - $(foreach func,$(word 1,$(1)),\ - $(foreach lst,$(word 2,$(1)),\ - $(foreach type,list,\ - $(foreach new_hcode,$(call __new_obj_hash_code),\ - $(foreach sz,$(words $(call __get_obj_values,$(lst))),\ - $(eval $(__obj_magic)_$(type)_$(new_hcode)_value := $(strip \ - $(foreach val,$(call __get_obj_values,$(lst)),\ - $(call $(func)_value,$(val))))))\ - $(__obj_magic)_$(type)_$(new_hcode)))))) - -conj = $(word 1,$(foreach new_list,$(call __new_obj_like,$(word 1,$(1))),\ - $(new_list) \ - $(eval $(new_list)_value := $(strip $($(word 1,$(1))_value))) \ - $(if $(call _list?,$(new_list)),\ - $(foreach elem,$(wordlist 2,$(words $(1)),$(1)),\ - $(eval $(new_list)_value := $(strip $(elem) $($(new_list)_value)))),\ - $(eval $(new_list)_value := $(strip $($(new_list)_value) $(wordlist 2,$(words $(1)),$(1))))))) - -seq = $(strip\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),$(__nil),$(1)),\ - $(if $(call _vector?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(__nil),\ - $(word 1,$(foreach new_list,$(call _list),\ - $(new_list) \ - $(eval $(new_list)_value := $(strip $($(word 1,$(1))_value)))))),\ - $(if $(call _EQ,string,$(call _obj_type,$(1))),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(__nil),\ - $(word 1,$(foreach new_list,$(call _list),\ - $(new_list) \ - $(eval $(new_list)_value := $(strip \ - $(foreach c,$($(word 1,$(1))_value),\ - $(call _string,$(c)))))))),\ - $(if $(call _nil?,$(1)),\ - $(__nil),\ - $(call _error,seq: called on non-sequence)))))) +map = $(call list,$(foreach e,$(call _seq_vals,$(lastword $1))\ + ,$(call _apply,$(firstword $1),$e))) + +conj = $(foreach seq,$(firstword $1)\ + ,$(call conj_$(call _obj_type,$(seq)),$(call _seq_vals,$(seq)),$(_rest))) +# Strip in case $1 or $2 is empty. +# Also, _reverse introduces blanks. +conj_vector = $(call vector,$(strip $1 $2)) +conj_list = $(call list,$(strip $(call _reverse,$2) $1)) + +seq = $(or $(seq_$(_obj_type))\ + ,$(call _error,seq: called on non-sequence)) +seq_list = $(if $(_seq_vals),$1,$(__nil)) +seq_vector = $(if $(_seq_vals),$(call list,$(_seq_vals)),$(__nil)) +seq_nil = $1 +seq_string = $(if $(_string_val)\ + ,$(call list,$(foreach c,$(call str_encode,$(_string_val))\ + ,$(call _string,$(call str_decode,$c))))$(rem \ + ),$(__nil)) # Metadata functions -with_meta = $(strip \ - $(foreach new_obj,$(call _clone_obj,$(word 1,$(1))),\ - $(eval $(new_obj)_meta := $(strip $(word 2,$(1))))\ - $(new_obj))) - -meta = $(strip $($(1)_meta)) +# are implemented in types.mk. # Atom functions -atom = $(strip \ - $(foreach hcode,$(call __new_obj_hash_code),\ - $(foreach new_atom,$(__obj_magic)_atom_$(hcode),\ - $(new_atom)\ - $(eval $(new_atom)_value := $(1))))) -atom? = $(if $(call _atom?,$(1)),$(__true),$(__false)) - -deref = $($(1)_value) +atom? = $(if $(_atom?),$(__true),$(__false)) -reset! = $(eval $(word 1,$(1))_value := $(word 2,$(1)))$(word 2,$(1)) +reset! = $(foreach v,$(lastword $1),$(call _reset,$(firstword $1),$v)$v) -swap! = $(foreach resp,$(call $(word 2,$(1))_value,$($(word 1,$(1))_value) $(wordlist 3,$(words $(1)),$(1))),\ - $(eval $(word 1,$(1))_value := $(resp))\ - $(resp)) +swap! = $(foreach a,$(firstword $1)\ + ,$(call reset!,$a $(call _apply,$(word 2,$1),$(call deref,$a) $(_rest2)))) # Namespace of core functions -core_ns = type obj_type \ - = equal? \ - throw throw \ - nil? nil? \ - true? true? \ - false? false? \ - string? string? \ - symbol symbol \ - symbol? symbol? \ - keyword keyword \ - keyword? keyword? \ - number? number? \ - fn? fn? \ - macro? macro? \ - \ - pr-str pr_str \ - str str \ - prn prn \ - println println \ - readline readline \ - read-string read_str \ - slurp slurp \ - subs subs \ - < number_lt \ - <= number_lte \ - > number_gt \ - >= number_gte \ - + number_plus \ - - number_subtract \ - * number_multiply \ - / number_divide \ - time-ms time_ms \ - \ - list _list \ - list? list? \ - vector _vector \ - vector? vector? \ - hash-map _hash_map \ - map? hash_map? \ - assoc assoc \ - dissoc dissoc \ - get get \ - contains? contains? \ - keys keys \ - vals vals \ - \ - sequential? sequential? \ - cons cons \ - concat concat \ - vec vec \ - nth nth \ - first sfirst \ - rest srest \ - last slast \ - empty? empty? \ - count count \ - apply sapply \ - map smap \ - \ - conj conj \ - seq seq \ - \ - with-meta with_meta \ - meta meta \ - atom atom \ - atom? atom? \ - deref deref \ - reset! reset! \ - swap! swap! +core_ns := $(encoded_equal) throw nil? true? false? string? symbol \ + symbol? keyword keyword? number? fn? macro? \ + pr-str str prn println readline read-string slurp \ < \ + <$(encoded_equal) > >$(encoded_equal) + - * / time-ms \ + list list? vector vector? hash-map map? assoc dissoc get \ + contains? keys vals \ + sequential? cons concat vec nth first rest empty? count apply map \ + conj seq \ + with-meta meta atom atom? deref reset! swap! endif diff --git a/impls/make/env.mk b/impls/make/env.mk index 733ac62b56..67719d4543 100644 --- a/impls/make/env.mk +++ b/impls/make/env.mk @@ -14,31 +14,21 @@ include $(_TOP_DIR)types.mk # An ENV environment is a hash-map with an __outer__ reference to an # outer environment -define BIND_ARGS -$(strip \ - $(word 1,$(1) \ - $(foreach fparam,$(call _nth,$(2),0),\ - $(if $(call _EQ,&,$($(fparam)_value)), - $(call ENV_SET,$(1),$($(call _nth,$(2),1)_value),$(strip \ - $(foreach new_list,$(call _list), - $(word 1,$(new_list) \ - $(foreach val,$(3),$(call _conj!,$(new_list),$(val))))))),\ - $(foreach val,$(word 1,$(3)),\ - $(call ENV_SET,$(1),$($(fparam)_value),$(val))\ - $(foreach left,$(call srest,$(2)),\ - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call BIND_ARGS,$(1),$(left),$(wordlist 2,$(words $(3)),$(3)))))))))) -endef - -# Create a new ENV and optional bind values in it -# $(1): outer environment (set as a key named __outer__) -# $(2): list/vector object of bind forms -# $(3): space separated list of expressions to bind -ENV = $(strip $(foreach new_env,$(call _assoc!,$(call _hash_map),__outer__,$(if $(1),$(1),$(__nil))),$(if $(2),$(call BIND_ARGS,$(new_env),$(2),$(3)),$(new_env)))) - -ENV_GET = $(if $(call _EQ,$(1),$(__nil)),,$(or $(_get),$(call ENV_GET,$(call _get,$(1),__outer__),$(2)))) - -ENV_SET = $(if $(call _assoc!,$(1),$(subst =,$(__equal),$(2)),$(3)),$(1),) + +# Keys are stored as Make variables named $(env)_$(key). The outer +# environment is the content of the variable itself. + +# 1: outer environment, or "" -> new environment +ENV = $(call __new_obj,env,$1) + +# 1:env 2:key -> value or "" +ENV_GET = $(if $1,$(or $($1_$2),$(call ENV_GET,$($1),$2))) + +# 1:env 2:key 3:value +ENV_SET = $(eval $1_$2 := $3) + +# 1:env -> (encoded) keys +env_keys = $(foreach k,$(patsubst $1_%,%,$(filter $1_%,$(.VARIABLES)))\ + ,$(call _symbol_val,$k)) endif diff --git a/impls/make/printer.mk b/impls/make/printer.mk index adf859cac7..0187424d7f 100644 --- a/impls/make/printer.mk +++ b/impls/make/printer.mk @@ -11,37 +11,45 @@ include $(_TOP_DIR)types.mk # return a printable form of the argument, the second parameter is # 'print_readably' which backslashes quotes in string values -_pr_str = $(if $(1),$(foreach ot,$(call _obj_type,$(1)),$(if $(call _EQ,make,$(ot)),$(call _error,_pr_str failed on $(1)),$(call $(ot)_pr_str,$(1),$(2)))),) +_pr_str = $(call $(_obj_type)_pr_str,$1,$2) # Like _pr_str but takes multiple values in first argument, the second # parameter is 'print_readably' which backslashes quotes in string # values, the third parameter is the delimeter to use between each # _pr_str'd value -_pr_str_mult = $(call _pr_str,$(word 1,$(1)),$(2))$(if $(word 2,$(1)),$(3)$(call _pr_str_mult,$(wordlist 2,$(words $(1)),$(1)),$(2),$(3)),) +_pr_str_mult = $(subst $(SPACE),$3,$(foreach f,$1,$(call _pr_str,$f,$2))) # Type specific printing -nil_pr_str = nil -true_pr_str = true -false_pr_str = false +nil_pr_str := nil +true_pr_str := true +false_pr_str := false -number_pr_str = $(call int_decode,$($(1)_value)) +number_pr_str = $(_number_val) -symbol_pr_str = $($(1)_value) +symbol_pr_str = $(_symbol_val) -keyword_pr_str = $(COLON)$(patsubst $(__keyword)%,%,$(call str_decode,$($(1)_value))) +keyword_pr_str = $(encoded_colon)$(_keyword_val) -string_pr_str = $(if $(filter $(__keyword)%,$(call str_decode,$($(1)_value))),$(COLON)$(patsubst $(__keyword)%,%,$(call str_decode,$($(1)_value))),$(if $(2),"$(subst $(NEWLINE),$(ESC_N),$(subst $(DQUOTE),$(ESC_DQUOTE),$(subst $(SLASH),$(SLASH)$(SLASH),$(call str_decode,$($(1)_value)))))",$(call str_decode,$($(1)_value)))) +string_pr_str = $(if $2\ + ,"$(subst $(_NL),$(encoded_slash)n,$(rem \ + )$(subst ",$(encoded_slash)",$(rem \ + )$(subst $(encoded_slash),$(encoded_slash)$(encoded_slash),$(rem \ + )$(_string_val))))"$(rem \ +else \ + ),$(_string_val)) -function_pr_str = +corefn_pr_str := +function_pr_str := +macro_pr_str := -list_pr_str = ($(foreach v,$(call __get_obj_values,$(1)),$(call _pr_str,$(v),$(2)))) +list_pr_str = $(_LP)$(call _pr_str_mult,$(_seq_vals),$2,$(_SP))$(_RP) -vector_pr_str = [$(foreach v,$(call __get_obj_values,$(1)),$(call _pr_str,$(v),$(2)))] +vector_pr_str = [$(call _pr_str_mult,$(_seq_vals),$2,$(_SP))] -hash_map_pr_str = {$(foreach v,$(call __get_obj_values,$(1)),$(foreach vval,$(foreach hcode,$(word 3,$(subst _, ,$(1))),$(patsubst $(1)_%,%,$(v:%_value=%))),$(if $(filter $(__keyword)%,$(vval)),$(patsubst $(__keyword)%,$(COLON)%,$(vval)),"$(vval)")) $(call _pr_str,$($(v)),$(2)))} +map_pr_str = {$(call _pr_str_mult,$(foreach k,$(_keys),$k $(call _get,$1,$k)),$2,$(_SP))} -atom_pr_str = (atom $(call _pr_str,$($(1)_value),$(2))) +atom_pr_str = $(_LP)atom$(_SP)$(call _pr_str,$(deref),$2)$(_RP) endif diff --git a/impls/make/readline.mk b/impls/make/readline.mk index 3d08ab199b..ab4e287134 100644 --- a/impls/make/readline.mk +++ b/impls/make/readline.mk @@ -5,19 +5,22 @@ ifndef __mal_readline_included __mal_readline_included := true +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)util.mk + # Call bash read/readline. Since each call is in a separate shell # instance we need to restore and save after each call in order to # have readline history. -READLINE_EOF := READLINE_HISTORY_FILE := $${HOME}/.mal-history -READLINE = $(eval __readline_temp := $(subst #,\#,$(subst $$,$$$$,$(shell \ + +# Either empty (if EOF) or an encoded string with the 'ok' suffix. +READLINE = $(call str_encode_nospace,$(shell \ history -r $(READLINE_HISTORY_FILE); \ - read -u 0 -r -e -p $(if $(1),$(1),"user> ") line && \ + read -u 0 -r -e -p '$(str_decode_nospace)' line && \ history -s -- "$${line}" && \ - echo "$${line}" || \ - echo "__||EOF||__"; \ + echo "$${line}ok" ; \ history -a $(READLINE_HISTORY_FILE) 2>/dev/null || \ true \ -))))$(if $(filter __||EOF||__,$(__readline_temp)),$(eval READLINE_EOF := yes),$(__readline_temp))$(if $(DEBUG_READLINE),$(warning readline/$(__readline_temp)/)) +)) endif diff --git a/impls/make/step2_eval.mk b/impls/make/step2_eval.mk index f03d6d73de..1dd8f231b2 100644 --- a/impls/make/step2_eval.mk +++ b/impls/make/step2_eval.mk @@ -2,66 +2,86 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1))))\ - $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ - $(call _apply,$(call sfirst,$(el)),$(call srest,$(el))))) +# EVAL: evaluate the parameter + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call _get,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) endef -# EVAL: evaluate the parameter define EVAL -$(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(if $(call _contains?,$(2),$(key)),\ - $(call _get,$(2),$(key)),\ - $(call _error,'$(key)' not found in REPL_ENV))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(strip $(call EVAL_INVOKE,$(1),$(2)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(EVAL_DEBUG),\ + $(call print,EVAL: $(call _pr_str,$1,yes)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: -REPL_ENV := $(call _hash_map) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REPL_ENV := $(call hash-map,$(foreach f,+ - * /\ + ,$(call _symbol,$f) $(call _corefn,$f))) -$(call do,$(call _assoc!,$(REPL_ENV),+,number_plus)) -$(call do,$(call _assoc!,$(REPL_ENV),-,number_subtract)) -$(call do,$(call _assoc!,$(REPL_ENV),*,number_multiply)) -$(call do,$(call _assoc!,$(REPL_ENV),/,number_divide)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef # repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) +$(REPL) + +# Do not complain that there is no target. +.PHONY: none +none: + @true diff --git a/impls/make/step3_env.mk b/impls/make/step3_env.mk index ccd1fbfd20..0adc209b3b 100644 --- a/impls/make/step3_env.mk +++ b/impls/make/step3_env.mk @@ -2,6 +2,8 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -9,84 +11,98 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef # EVAL: evaluate the parameter -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ - $(call _apply,$(call sfirst,$(el)),$(call srest,$(el)))))))) +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) +endef + +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) endef define EVAL -$(strip $(if $(__ERROR),,\ - $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ - $(info EVAL: $(_pr_str)))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(or $(call ENV_GET,$(2),$(key)),\ - $(call _error,'$(key)' not found)$(__nil))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef # Setup the environment -REPL_ENV := $(call ENV_SET,$(REPL_ENV),+,number_plus) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),-,number_subtract) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*,number_multiply) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),/,number_divide) +$(foreach f,+ - * /\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) # repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) +$(REPL) + +# Do not complain that there is no target. +.PHONY: none +none: + @true diff --git a/impls/make/step4_if_fn_do.mk b/impls/make/step4_if_fn_do.mk index 529f5e5a5c..6384f63507 100644 --- a/impls/make/step4_if_fn_do.mk +++ b/impls/make/step4_if_fn_do.mk @@ -2,6 +2,8 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -9,102 +11,120 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef # EVAL: evaluate the parameter -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) +endef + +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args)))))))))))) +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) endef +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + define EVAL -$(strip $(if $(__ERROR),,\ - $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ - $(info EVAL: $(_pr_str)))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(or $(call ENV_GET,$(2),$(key)),\ - $(call _error,'$(key)' not found)$(__nil))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef # core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) # core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) +$(call RE, (def! not (fn* (a) (if a false true))) ) # repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) +$(REPL) + +# Do not complain that there is no target. +.PHONY: none +none: + @true diff --git a/impls/make/step6_file.mk b/impls/make/step6_file.mk index 6bdad802ce..265d25f76f 100644 --- a/impls/make/step6_file.mk +++ b/impls/make/step6_file.mk @@ -2,6 +2,8 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -9,117 +11,132 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef # EVAL: evaluate the parameter -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args)))))))))))) +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) endef +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) +endef + +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + define EVAL -$(strip $(if $(__ERROR),,\ - $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ - $(info EVAL: $(_pr_str)))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(or $(call ENV_GET,$(2),$(key)),\ - $(call _error,'$(key)' not found)$(__nil))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef # core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +core_eval = $(call EVAL,$1,$(REPL_ENV)) +$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) + +$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ + $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) # core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) )) +$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) +ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - +$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) +else # repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) +$(REPL) +endif +# Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true diff --git a/impls/make/step7_quote.mk b/impls/make/step7_quote.mk index a239e5cb69..68665fb325 100644 --- a/impls/make/step7_quote.mk +++ b/impls/make/step7_quote.mk @@ -2,6 +2,8 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -9,140 +11,168 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef # EVAL: evaluate the parameter +# If $1 is empty, `foreach` does no iteration at all. +starts_with? = $(foreach f,$(firstword $1)\ + ,$(and $(call _symbol?,$f),\ + $(filter $2,$(call _symbol_val,$f)))) + # elt, accumulator list -> new accumulator list -QQ_LOOP = $(call _list,\ - $(if $(and $(_list?),$(call _EQ,splice-unquote,$($(sfirst)_value))),\ - $(call _symbol,concat) $(call _nth,$1,1),\ - $(call _symbol,cons) $(QUASIQUOTE))\ - $2) +QQ_LOOP = $(if $(and $(_list?),\ + $(call starts_with?,$(_seq_vals),splice-unquote))\ + ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ + ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) # list or vector source -> right folded list -QQ_FOLD = $(if $(_empty?),$(call _list,),$(call QQ_LOOP,$(sfirst),$(call QQ_FOLD,$(srest)))) - -QUASIQUOTE = $(strip \ - $(if $(_list?), $(if $(call _EQ,unquote,$($(sfirst)_value)),\ - $(call _nth,$1,1),\ - $(QQ_FOLD)),\ - $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ - $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ - $1)))) - -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) +QQ_FOLD = $(if $1\ + ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ + ),$(call list)) + +QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) +QUASIQUOTE_nil = $1 +QUASIQUOTE_true = $1 +QUASIQUOTE_false = $1 +QUASIQUOTE_string = $1 +QUASIQUOTE_number = $1 +QUASIQUOTE_keyword = $1 +QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) +QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) + +QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) + +QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ + ,$(lastword $(_seq_vals))$(rem \ + ),$(call QQ_FOLD,$(_seq_vals))) + +EVAL_special_quote = $1 + +EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,quote,$($(a0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquote,$($(a0)_value)),\ - $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args)))))))))))))) +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) endef +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) +endef + +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + define EVAL -$(strip $(if $(__ERROR),,\ - $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ - $(info EVAL: $(_pr_str)))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(or $(call ENV_GET,$(2),$(key)),\ - $(call _error,'$(key)' not found)$(__nil))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef # core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +core_eval = $(call EVAL,$1,$(REPL_ENV)) +$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) + +$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ + $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) # core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) )) +$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) +ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - +$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) +else # repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) +$(REPL) +endif +# Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true diff --git a/impls/make/step8_macros.mk b/impls/make/step8_macros.mk index 07f17b7000..7815c9d80f 100644 --- a/impls/make/step8_macros.mk +++ b/impls/make/step8_macros.mk @@ -2,6 +2,8 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -9,146 +11,176 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef # EVAL: evaluate the parameter +# If $1 is empty, `foreach` does no iteration at all. +starts_with? = $(foreach f,$(firstword $1)\ + ,$(and $(call _symbol?,$f),\ + $(filter $2,$(call _symbol_val,$f)))) + # elt, accumulator list -> new accumulator list -QQ_LOOP = $(call _list,\ - $(if $(and $(_list?),$(call _EQ,splice-unquote,$($(sfirst)_value))),\ - $(call _symbol,concat) $(call _nth,$1,1),\ - $(call _symbol,cons) $(QUASIQUOTE))\ - $2) +QQ_LOOP = $(if $(and $(_list?),\ + $(call starts_with?,$(_seq_vals),splice-unquote))\ + ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ + ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) # list or vector source -> right folded list -QQ_FOLD = $(if $(_empty?),$(call _list,),$(call QQ_LOOP,$(sfirst),$(call QQ_FOLD,$(srest)))) - -QUASIQUOTE = $(strip \ - $(if $(_list?), $(if $(call _EQ,unquote,$($(sfirst)_value)),\ - $(call _nth,$1,1),\ - $(QQ_FOLD)),\ - $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ - $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ - $1)))) -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) +QQ_FOLD = $(if $1\ + ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ + ),$(call list)) + +QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) +QUASIQUOTE_nil = $1 +QUASIQUOTE_true = $1 +QUASIQUOTE_false = $1 +QUASIQUOTE_string = $1 +QUASIQUOTE_number = $1 +QUASIQUOTE_keyword = $1 +QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) +QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) + +QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) + +QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ + ,$(lastword $(_seq_vals))$(rem \ + ),$(call QQ_FOLD,$(_seq_vals))) + +EVAL_special_quote = $1 + +EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(if $(call _macro?,$f)\ + ,$(call EVAL,$(call _apply,$f,$(_rest)),$2)$(rem \ + ),$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2)))))) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,quote,$($(a0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquote,$($(a0)_value)),\ - $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ - $(if $(call _EQ,defmacro!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call _clone_obj,$(call EVAL,$(a2),$(2))),\ - $(eval _macro_$(res) = true)\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach f,$(call EVAL,$(a0),$(2)),\ - $(foreach args,$(call srest,$(1)),\ - $(if $(_macro_$(f)),\ - $(call EVAL,$(call apply,$(f),$(args)),$(2)),\ - $(call apply,$(f),$(call _smap,EVAL,$(args),$(2)))))))))))))))) +define EVAL_special_defmacro! +$(foreach res,$(call _as_macro,$(call EVAL,$(lastword $1),$2))\ + ,$(res)$(call ENV_SET,$2,$(firstword $1),$(res))) endef +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) +endef + +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + define EVAL -$(strip $(if $(__ERROR),,\ - $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ - $(info EVAL: $(_pr_str)))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(or $(call ENV_GET,$(2),$(key)),\ - $(call _error,'$(key)' not found)$(__nil))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef # core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +core_eval = $(call EVAL,$1,$(REPL_ENV)) +$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) + +$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ + $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) # core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) )) -$(call do,$(call 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))))))) )) +$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) +$(call RE, (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))))))) ) +ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - +$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) +else # repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) +$(REPL) +endif +# Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true diff --git a/impls/make/step9_try.mk b/impls/make/step9_try.mk index 7a9b8653b1..4d80fd9810 100644 --- a/impls/make/step9_try.mk +++ b/impls/make/step9_try.mk @@ -2,6 +2,8 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -9,161 +11,192 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef # EVAL: evaluate the parameter +# If $1 is empty, `foreach` does no iteration at all. +starts_with? = $(foreach f,$(firstword $1)\ + ,$(and $(call _symbol?,$f),\ + $(filter $2,$(call _symbol_val,$f)))) + # elt, accumulator list -> new accumulator list -QQ_LOOP = $(call _list,\ - $(if $(and $(_list?),$(call _EQ,splice-unquote,$($(sfirst)_value))),\ - $(call _symbol,concat) $(call _nth,$1,1),\ - $(call _symbol,cons) $(QUASIQUOTE))\ - $2) +QQ_LOOP = $(if $(and $(_list?),\ + $(call starts_with?,$(_seq_vals),splice-unquote))\ + ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ + ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) # list or vector source -> right folded list -QQ_FOLD = $(if $(_empty?),$(call _list,),$(call QQ_LOOP,$(sfirst),$(call QQ_FOLD,$(srest)))) - -QUASIQUOTE = $(strip \ - $(if $(_list?), $(if $(call _EQ,unquote,$($(sfirst)_value)),\ - $(call _nth,$1,1),\ - $(QQ_FOLD)),\ - $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ - $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ - $1)))) -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) +QQ_FOLD = $(if $1\ + ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ + ),$(call list)) + +QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) +QUASIQUOTE_nil = $1 +QUASIQUOTE_true = $1 +QUASIQUOTE_false = $1 +QUASIQUOTE_string = $1 +QUASIQUOTE_number = $1 +QUASIQUOTE_keyword = $1 +QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) +QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) + +QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) + +QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ + ,$(lastword $(_seq_vals))$(rem \ + ),$(call QQ_FOLD,$(_seq_vals))) + +EVAL_special_quote = $1 + +EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(if $(call _macro?,$f)\ + ,$(call EVAL,$(call _apply,$f,$(_rest)),$2)$(rem \ + ),$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2)))))) +endef + +define EVAL_special_defmacro! +$(foreach res,$(call _as_macro,$(call EVAL,$(lastword $1),$2))\ + ,$(res)$(call ENV_SET,$2,$(firstword $1),$(res))) +endef + +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,quote,$($(a0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquote,$($(a0)_value)),\ - $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ - $(if $(call _EQ,defmacro!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call _clone_obj,$(call EVAL,$(a2),$(2))),\ - $(eval _macro_$(res) = true)\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ - $(if $(call _EQ,try*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach res,$(call EVAL,$(a1),$(2)),\ - $(if $(__ERROR),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach a20,$(call _nth,$(a2),0),\ - $(if $(call _EQ,catch*,$($(a20)_value)),\ - $(foreach a21,$(call _nth,$(a2),1),\ - $(foreach a22,$(call _nth,$(a2),2),\ - $(foreach binds,$(call _list,$(a21)),\ - $(foreach catch_env,$(call ENV,$(2),$(binds),$(__ERROR)),\ - $(eval __ERROR :=)\ - $(call EVAL,$(a22),$(catch_env)))))),\ - $(res)))),\ - $(res)))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach f,$(call EVAL,$(a0),$(2)),\ - $(foreach args,$(call srest,$(1)),\ - $(if $(_macro_$(f)),\ - $(call EVAL,$(call apply,$(f),$(args)),$(2)),\ - $(call apply,$(f),$(call _smap,EVAL,$(args),$(2))))))))))))))))) +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + +# EVAL may fail and return nothing, so the first foreach may execute +# nothing, so we need to duplicate the test for error. +# The second foreach deliberately does nothing when there is no +# catch_list. +define EVAL_special_try* +$(foreach res,$(call EVAL,$(firstword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)))$(rem \ +)$(if $(__ERROR)\ + ,$(foreach catch_list,$(word 2,$1)\ + ,$(foreach env,$(call ENV,$2)\ + ,$(call ENV_SET,$(env),$(word 2,$(call _seq_vals,$(catch_list))),$(__ERROR))$(rem \ + )$(eval __ERROR :=)$(rem \ + )$(call EVAL,$(lastword $(call _seq_vals,$(catch_list))),$(env))))) endef define EVAL -$(strip $(if $(__ERROR),,\ - $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ - $(info EVAL: $(_pr_str)))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(or $(call ENV_GET,$(2),$(key)),\ - $(call _error,'$(key)' not found)$(__nil))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef # core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +core_eval = $(call EVAL,$1,$(REPL_ENV)) +$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) + +$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ + $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) # core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) )) -$(call do,$(call 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))))))) )) +$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) +$(call RE, (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))))))) ) +ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - +$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) +else # repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) +$(REPL) +endif +# Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true diff --git a/impls/make/stepA_mal.mk b/impls/make/stepA_mal.mk index 275524ee6c..5b7788e562 100644 --- a/impls/make/stepA_mal.mk +++ b/impls/make/stepA_mal.mk @@ -2,6 +2,8 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -9,168 +11,199 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef # EVAL: evaluate the parameter +# If $1 is empty, `foreach` does no iteration at all. +starts_with? = $(foreach f,$(firstword $1)\ + ,$(and $(call _symbol?,$f),\ + $(filter $2,$(call _symbol_val,$f)))) + # elt, accumulator list -> new accumulator list -QQ_LOOP = $(call _list,\ - $(if $(and $(_list?),$(call _EQ,splice-unquote,$($(sfirst)_value))),\ - $(call _symbol,concat) $(call _nth,$1,1),\ - $(call _symbol,cons) $(QUASIQUOTE))\ - $2) +QQ_LOOP = $(if $(and $(_list?),\ + $(call starts_with?,$(_seq_vals),splice-unquote))\ + ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ + ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) # list or vector source -> right folded list -QQ_FOLD = $(if $(_empty?),$(call _list,),$(call QQ_LOOP,$(sfirst),$(call QQ_FOLD,$(srest)))) - -QUASIQUOTE = $(strip \ - $(if $(_list?), $(if $(call _EQ,unquote,$($(sfirst)_value)),\ - $(call _nth,$1,1),\ - $(QQ_FOLD)),\ - $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ - $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ - $1)))) -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) +QQ_FOLD = $(if $1\ + ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ + ),$(call list)) + +QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) +QUASIQUOTE_nil = $1 +QUASIQUOTE_true = $1 +QUASIQUOTE_false = $1 +QUASIQUOTE_string = $1 +QUASIQUOTE_number = $1 +QUASIQUOTE_keyword = $1 +QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) +QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) + +QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) + +QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ + ,$(lastword $(_seq_vals))$(rem \ + ),$(call QQ_FOLD,$(_seq_vals))) + +EVAL_special_quote = $1 + +EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(if $(call _macro?,$f)\ + ,$(call EVAL,$(call _apply,$f,$(_rest)),$2)$(rem \ + ),$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2)))))) +endef + +define EVAL_special_defmacro! +$(foreach res,$(call _as_macro,$(call EVAL,$(lastword $1),$2))\ + ,$(res)$(call ENV_SET,$2,$(firstword $1),$(res))) +endef + +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,quote,$($(a0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquote,$($(a0)_value)),\ - $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ - $(if $(call _EQ,defmacro!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call _clone_obj,$(call EVAL,$(a2),$(2))),\ - $(eval _macro_$(res) = true)\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ - $(if $(call _EQ,make*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(and $(EVAL_DEBUG),$(info make*: $$(eval __result := $(call str_decode,$(value $(a1)_value)))))\ - $(eval __result := $(call str_decode,$(value $(a1)_value)))$(call _string,$(__result))),\ - $(if $(call _EQ,try*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach res,$(call EVAL,$(a1),$(2)),\ - $(if $(__ERROR),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach a20,$(call _nth,$(a2),0),\ - $(if $(call _EQ,catch*,$($(a20)_value)),\ - $(foreach a21,$(call _nth,$(a2),1),\ - $(foreach a22,$(call _nth,$(a2),2),\ - $(foreach binds,$(call _list,$(a21)),\ - $(foreach catch_env,$(call ENV,$(2),$(binds),$(__ERROR)),\ - $(eval __ERROR :=)\ - $(call EVAL,$(a22),$(catch_env)))))),\ - $(res)))),\ - $(res)))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach f,$(call EVAL,$(a0),$(2)),\ - $(foreach args,$(call srest,$(1)),\ - $(if $(_macro_$(f)),\ - $(call EVAL,$(call apply,$(f),$(args)),$(2)),\ - $(call apply,$(f),$(call _smap,EVAL,$(args),$(2)))))))))))))))))) +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + +# EVAL may fail and return nothing, so the first foreach may execute +# nothing, so we need to duplicate the test for error. +# The second foreach deliberately does nothing when there is no +# catch_list. +define EVAL_special_try* +$(foreach res,$(call EVAL,$(firstword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)))$(rem \ +)$(if $(__ERROR)\ + ,$(foreach catch_list,$(word 2,$1)\ + ,$(foreach env,$(call ENV,$2)\ + ,$(call ENV_SET,$(env),$(word 2,$(call _seq_vals,$(catch_list))),$(__ERROR))$(rem \ + )$(eval __ERROR :=)$(rem \ + )$(call EVAL,$(lastword $(call _seq_vals,$(catch_list))),$(env))))) +endef + +define EVAL_special_make* +$(eval __result := $(call str_decode_nospace,$(_string_val)))$(rem \ +)$(call _string,$(call str_encode_nospace,$(__result))) endef define EVAL -$(strip $(if $(__ERROR),,\ - $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ - $(info EVAL: $(_pr_str)))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(or $(call ENV_GET,$(2),$(key)),\ - $(call _error,'$(key)' not found)$(__nil))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef # core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +core_eval = $(call EVAL,$1,$(REPL_ENV)) +$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) + +$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ + $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) # core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! *host-language* "make") )) -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) )) -$(call do,$(call 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))))))) )) +$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) +$(call RE, (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))))))) ) +$(call RE, (def! *host-language* "make") ) +ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - +$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) +else # repl loop -$(if $(strip $(INTERACTIVE)),\ - $(call do,$(call REP, (println (str "Mal [" *host-language* "]")) )) \ - $(call REPL)) +$(call RE, (println (str "Mal [" *host-language* "]")) ) +$(REPL) +endif +# Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true diff --git a/impls/make/util.mk b/impls/make/util.mk index 887798542b..898e9ed28d 100644 --- a/impls/make/util.mk +++ b/impls/make/util.mk @@ -8,53 +8,34 @@ __mal_util_included := true _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)gmsl.mk -SEMI := ; +encoded_equal := Ξ +encoded_colon := κ +encoded_slash := λ +raw_hash := \# +encoded_hash := η + COMMA := , COLON := : -LCURLY := { -RCURLY := } LPAREN := ( RPAREN := ) -LBRACKET := [ -RBRACKET := ] -DQUOTE := "# " SLASH := $(strip \ ) -ESC_DQUOTE := $(SLASH)$(DQUOTE) -ESC_N := $(SLASH)n -SQUOTE := '# ' -QQUOTE := `# ` -SPACE := $(hopefully_undefined) $(hopefully_undefined) -MINUS := - -NUMBERS := 0 1 2 3 4 5 6 7 8 9 -UNQUOTE := ~ -SPLICE_UNQUOTE := ~@ +SPACE := +SPACE := $(SPACE) $(SPACE) define NEWLINE endef -CARET := ^ -ATSIGN := @ -HASH := \# -_HASH := © # \u00ab _LP := « # \u00bb _RP := » -# \u00ed -_LC := í -# \u00ec -_RC := ì ## \u00a7 _SP := § ## \u00ae -_SUQ := ® -## \u015e _DOL := Åž ## \u00b6 _NL := ¶ -## \u00a8 -###_EDQ := ¨ # @@ -63,38 +44,67 @@ _NL := ¶ _EQ = $(if $(subst x$1,,x$2)$(subst x$2,,x$1),,true) -_NOT = $(if $1,,true) - -# take a list of words and join them with a separator -# params: words, seperator, result -_join = $(strip \ - $(if $(strip $(1)),\ - $(if $(strip $(3)),\ - $(call _join,$(wordlist 2,$(words $(1)),$(1)),$(2),$(3)$(2)$(word 1,$(1))),\ - $(call _join,$(wordlist 2,$(words $(1)),$(1)),$(2),$(word 1,$(1)))),\ - $(3))) - -#$(info _join(1 2 3 4): [$(call _join,1 2 3 4)]) -#$(info _join(1 2 3 4,X): [$(call _join,1 2 3 4, )]) -#$(info _join(1): [$(call _join,1)]) -#$(info _join(): [$(call _join,)]) - # reverse list of words -_reverse = $(if $(1),$(call _reverse,$(wordlist 2,$(words $(1)),$(1)))) $(firstword $(1)) +_reverse = $(if $1,$(call _reverse,$(_rest)) $(firstword $1)) + #$(info reverse(1 2 3 4 5): $(call reverse,1 2 3 4 5)) # str_encode: take a string and return an encoded version of it with # every character separated by a space and special characters replaced # with special Unicode characters -str_encode = $(strip $(eval __temp := $$(subst $$$$,$(_DOL) ,$$(subst $(SPLICE_UNQUOTE),$(_SUQ) ,$$(subst $$(LPAREN),$$(_LP) ,$$(subst $$(RPAREN),$$(_RP) ,$$(subst $$(LCURLY),$$(_LC) ,$$(subst $$(RCURLY),$$(_RC) ,$$(subst $$(NEWLINE),$$(_NL) ,$$(subst $$(HASH),$(_HASH) ,$$(subst $$(SPACE),$(_SP) ,$$1))))))))))$(foreach a,$(gmsl_characters),$(eval __temp := $$(subst $$a,$$a$$(SPACE),$(__temp))))$(__temp)) +define str_encode +$(eval __temp := $1)$(rem \ +)$(foreach a,$(encoded_slash) $(_DOL) $(_LP) $(_RP) $(_NL) \ + $(encoded_hash) $(encoded_colon) $(_SP) $(encoded_equal) $(gmsl_characters)\ + ,$(eval __temp := $$(subst $$a,$$a$$(SPACE),$(__temp))))$(rem \ +)$(__temp) +endef # str_decode: take an encoded string an return an unencoded version of # it by replacing the special Unicode charactes with the real # characters and with all characters joined into a regular string -str_decode = $(subst $(_SP),$(SPACE),$(subst $(_NL),$(NEWLINE),$(subst $(_LC),$(LCURLY),$(subst $(_RC),$(RCURLY),$(subst $(_LP),$(LPAREN),$(subst $(_RP),$(RPAREN),$(subst $(_SUQ),$(SPLICE_UNQUOTE),$(subst $(_DOL),$$,$(subst $(_HASH),$(HASH),$(strip $(call _join,$(1)))))))))))) +str_decode = $(subst $(SPACE),,$1) + +define str_encode_nospace +$(subst $(SLASH),$(encoded_slash),$(rem \ +)$(subst $$,$(_DOL),$(rem \ +)$(subst $(LPAREN),$(_LP),$(rem \ +)$(subst $(RPAREN),$(_RP),$(rem \ +)$(subst $(NEWLINE),$(_NL),$(rem \ +)$(subst $(raw_hash),$(encoded_hash),$(rem \ +)$(subst $(COLON),$(encoded_colon),$(rem \ +)$(subst $(SPACE),$(_SP),$(rem \ +)$(subst =,$(encoded_equal),$(rem \ +)$1))))))))) +endef + +define str_decode_nospace +$(subst $(encoded_slash),$(SLASH),$(rem \ +)$(subst $(_DOL),$$,$(rem \ +)$(subst $(_LP),$(LPAREN),$(rem \ +)$(subst $(_RP),$(RPAREN),$(rem \ +)$(subst $(_NL),$(NEWLINE),$(rem \ +)$(subst $(encoded_hash),$(raw_hash),$(rem \ +)$(subst $(encoded_colon),$(COLON),$(rem \ +)$(subst $(_SP),$(SPACE),$(rem \ +)$(subst $(encoded_equal),=,$1))))))))) +endef # Read a whole file substituting newlines with $(_NL) -_read_file = $(subst $(_NL),$(NEWLINE),$(shell out=""; while read -r l; do out="$${out}$${l}$(_NL)"; done < $(1); echo "$$out")) +_read_file = $(call str_encode_nospace,$(shell \ + sed -z 's/\n/$(_NL)/g' '$(str_decode_nospace)')) + +print = $(info $(str_decode_nospace)) + +_rest = $(wordlist 2,$(words $1),$1) +_rest2 = $(wordlist 3,$(words $1),$1) + +# Evaluate $2 repeatedly with $k and $v set to key/value pairs from $1. +define _foreach2 +$(foreach k,$(firstword $1)\ + ,$(foreach v,$(word 2,$1)\ + ,$(eval $2)$(call _foreach2,$(_rest2),$2))) +endef endif diff --git a/impls/python/env.py b/impls/python/env.py index 813369d9ec..d20e19fdc8 100644 --- a/impls/python/env.py +++ b/impls/python/env.py @@ -31,7 +31,3 @@ def get(self, key, return_nil=False): return None raise Exception("'" + key + "' not found") return env.data[key] - - def get_or_nil(self, key): - env = self.find(key) - if env: return env.data[key] diff --git a/impls/python/reader.py b/impls/python/reader.py index c74b1a7395..6f76563870 100644 --- a/impls/python/reader.py +++ b/impls/python/reader.py @@ -1,5 +1,6 @@ import re -from mal_types import (_symbol, _keyword, _list, _vector, _hash_map, _s2u, _u) + +from mal_types import (_symbol, _keyword, _list, List, Vector, Hash_Map, asPairs) class Blank(Exception): pass @@ -23,7 +24,7 @@ def tokenize(str): return [t for t in re.findall(tre, str) if t[0] != ';'] def _unescape(s): - return s.replace('\\\\', _u('\u029e')).replace('\\"', '"').replace('\\n', '\n').replace(_u('\u029e'), '\\') + return s.replace('\\\\', '\b').replace('\\"', '"').replace('\\n', '\n').replace('\b', '\\') def read_atom(reader): int_re = re.compile(r"-?[0-9]+$") @@ -31,8 +32,8 @@ def read_atom(reader): string_re = re.compile(r'"(?:[\\].|[^\\"])*"') token = reader.next() if re.match(int_re, token): return int(token) - elif re.match(float_re, token): return float(token) - elif re.match(string_re, token):return _s2u(_unescape(token[1:-1])) + elif re.match(float_re, token): return int(token) + elif re.match(string_re, token):return _unescape(token[1:-1]) elif token[0] == '"': raise Exception("expected '\"', got EOF") elif token[0] == ':': return _keyword(token[1:]) elif token == "nil": return None @@ -40,28 +41,26 @@ def read_atom(reader): elif token == "false": return False else: return _symbol(token) -def read_sequence(reader, typ=list, start='(', end=')'): - ast = typ() +def read_sequence(reader, start='(', end=')'): token = reader.next() if token != start: raise Exception("expected '" + start + "'") token = reader.peek() while token != end: if not token: raise Exception("expected '" + end + "', got EOF") - ast.append(read_form(reader)) + yield read_form(reader) token = reader.peek() reader.next() - return ast def read_hash_map(reader): - lst = read_sequence(reader, list, '{', '}') - return _hash_map(*lst) + lst = read_sequence(reader, '{', '}') + return Hash_Map(asPairs(lst)) def read_list(reader): - return read_sequence(reader, _list, '(', ')') + return List(read_sequence(reader, '(', ')')) def read_vector(reader): - return read_sequence(reader, _vector, '[', ']') + return Vector(read_sequence(reader, '[', ']')) def read_form(reader): token = reader.peek() diff --git a/impls/python/step3_env.py b/impls/python/step3_env.py index 73f9699e2d..1bbac127e5 100644 --- a/impls/python/step3_env.py +++ b/impls/python/step3_env.py @@ -5,19 +5,18 @@ from env import Env # read -def READ(str): - return reader.read_str(str) +READ = reader.read_str # eval def EVAL(ast, env): - dbgeval = env.get_or_nil('DEBUG-EVAL') + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) + return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -28,6 +27,7 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] + if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -35,17 +35,19 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) return EVAL(a2, let_env) - else: - f = EVAL(a0, env) + + f = EVAL(a0, env) + if types._function_Q(f): args = ast[1:] return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') # print -def PRINT(exp): - return printer._pr_str(exp) +PRINT = printer._pr_str # repl repl_env = Env() @@ -55,15 +57,16 @@ def REP(str): repl_env.set(types._symbol('+'), lambda a,b: a+b) repl_env.set(types._symbol('-'), lambda a,b: a-b) repl_env.set(types._symbol('*'), lambda a,b: a*b) -repl_env.set(types._symbol('/'), lambda a,b: int(a/b)) +repl_env.set(types._symbol('/'), lambda a,b: a//b) # repl loop while True: try: line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue print(REP(line)) + except EOFError: + print() + break except reader.Blank: continue - except Exception as e: + except Exception: print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/impls/python/step4_if_fn_do.py b/impls/python/step4_if_fn_do.py index e04e98e5ef..7845121364 100644 --- a/impls/python/step4_if_fn_do.py +++ b/impls/python/step4_if_fn_do.py @@ -6,19 +6,18 @@ import core # read -def READ(str): - return reader.read_str(str) +READ = reader.read_str # eval def EVAL(ast, env): - dbgeval = env.get_or_nil('DEBUG-EVAL') + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) + return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -29,6 +28,7 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] + if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -36,8 +36,8 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) return EVAL(a2, let_env) elif "do" == a0: for i in range(1, len(ast)-1): @@ -47,21 +47,27 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: - if len(ast) > 3: return EVAL(ast[3], env) - else: return None + if len(ast) > 3: + return EVAL(ast[3], env) + else: + return None else: return EVAL(a2, env) elif "fn*" == a0: a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - f = EVAL(a0, env) + def fn(*args): + return EVAL(a2, Env(env, a1, args)) + return fn + + f = EVAL(a0, env) + if types._function_Q(f): args = ast[1:] return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') # print -def PRINT(exp): - return printer._pr_str(exp) +PRINT = printer._pr_str # repl repl_env = Env() @@ -78,9 +84,10 @@ def REP(str): while True: try: line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue print(REP(line)) + except EOFError: + print() + break except reader.Blank: continue - except Exception as e: + except Exception: print("".join(traceback.format_exception(*sys.exc_info()))) diff --git a/impls/python/step5_tco.py b/impls/python/step5_tco.py index 74eedbee09..e045200945 100644 --- a/impls/python/step5_tco.py +++ b/impls/python/step5_tco.py @@ -6,21 +6,20 @@ import core # read -def READ(str): - return reader.read_str(str) +READ = reader.read_str # eval def EVAL(ast, env): while True: - dbgeval = env.get_or_nil('DEBUG-EVAL') + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) + return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -31,6 +30,7 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] + if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -38,40 +38,50 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) ast = a2 env = let_env - # Continue loop (TCO) + continue # TCO elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] - # Continue loop (TCO) + continue # TCO elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: - if len(ast) > 3: ast = ast[3] - else: ast = None + if len(ast) > 3: + ast = ast[3] + continue # TCO + else: + return None else: ast = a2 - # Continue loop (TCO) + continue # TCO elif "fn*" == a0: a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - f = EVAL(a0, env) + def fn(*args): + return EVAL(a2, Env(env, a1, args)) + fn.__ast__ = a2 + fn.__gen_env__ = lambda args: Env(env, a1, args) + return fn + + f = EVAL(a0, env) + if types._function_Q(f): args = ast[1:] if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) + env = f.__gen_env__(EVAL(a, env) for a in args) + continue # TCO else: return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') # print -def PRINT(exp): - return printer._pr_str(exp) +PRINT = printer._pr_str # repl repl_env = Env() @@ -88,9 +98,11 @@ def REP(str): while True: try: line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue print(REP(line)) + except EOFError: + print() + break except reader.Blank: continue - except Exception as e: + except Exception: + # See tests/step5_tco.mal in this directory. print("".join(traceback.format_exception(*sys.exc_info())[0:100])) diff --git a/impls/python/step6_file.py b/impls/python/step6_file.py index 4c0278e977..aed6e09f27 100644 --- a/impls/python/step6_file.py +++ b/impls/python/step6_file.py @@ -6,21 +6,20 @@ import core # read -def READ(str): - return reader.read_str(str) +READ = reader.read_str # eval def EVAL(ast, env): while True: - dbgeval = env.get_or_nil('DEBUG-EVAL') + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) + return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -31,6 +30,7 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] + if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -38,40 +38,50 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) ast = a2 env = let_env - # Continue loop (TCO) + continue # TCO elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] - # Continue loop (TCO) + continue # TCO elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: - if len(ast) > 3: ast = ast[3] - else: ast = None + if len(ast) > 3: + ast = ast[3] + continue # TCO + else: + return None else: ast = a2 - # Continue loop (TCO) + continue # TCO elif "fn*" == a0: a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - f = EVAL(a0, env) + def fn(*args): + return EVAL(a2, Env(env, a1, args)) + fn.__ast__ = a2 + fn.__gen_env__ = lambda args: Env(env, a1, args) + return fn + + f = EVAL(a0, env) + if types._function_Q(f): args = ast[1:] if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) + env = f.__gen_env__(EVAL(a, env) for a in args) + continue # TCO else: return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') # print -def PRINT(exp): - return printer._pr_str(exp) +PRINT = printer._pr_str # repl repl_env = Env() @@ -81,11 +91,11 @@ def REP(str): # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) -repl_env.set(types._symbol('*ARGV*'), types._list(*sys.argv[2:])) +repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') if len(sys.argv) >= 2: REP('(load-file "' + sys.argv[1] + '")') @@ -95,9 +105,11 @@ def REP(str): while True: try: line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue print(REP(line)) + except EOFError: + print() + break except reader.Blank: continue - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) + except Exception: + # See tests/step5_tco.mal in this directory. + print("".join(traceback.format_exception(*sys.exc_info())[0:100])) diff --git a/impls/python/step7_quote.py b/impls/python/step7_quote.py index 89e8265cb1..21fe4e3436 100644 --- a/impls/python/step7_quote.py +++ b/impls/python/step7_quote.py @@ -7,43 +7,47 @@ import core # read -def READ(str): - return reader.read_str(str) +READ = reader.read_str # eval def qq_loop(acc, elt): - if types._list_Q(elt) and len(elt) == 2 and elt[0] == u'splice-unquote': - return types._list(types._symbol(u'concat'), elt[1], acc) + if types._list_Q(elt) \ + and len(elt) == 2 \ + and types._symbol_Q(elt[0]) \ + and elt[0] == 'splice-unquote': + return types._list(types._symbol('concat'), elt[1], acc) else: - return types._list(types._symbol(u'cons'), quasiquote(elt), acc) + return types._list(types._symbol('cons'), quasiquote(elt), acc) def qq_foldr(seq): return functools.reduce(qq_loop, reversed(seq), types._list()) def quasiquote(ast): if types._list_Q(ast): - if len(ast) == 2 and ast[0] == u'unquote': + if len(ast) == 2 \ + and types._symbol_Q(ast[0]) \ + and ast[0] == 'unquote': return ast[1] else: return qq_foldr(ast) elif types._hash_map_Q(ast) or types._symbol_Q(ast): - return types._list(types._symbol(u'quote'), ast) - elif types._vector_Q (ast): - return types._list(types._symbol(u'vec'), qq_foldr(ast)) + return types._list(types._symbol('quote'), ast) + elif types._vector_Q(ast): + return types._list(types._symbol('vec'), qq_foldr(ast)) else: return ast def EVAL(ast, env): while True: - dbgeval = env.get_or_nil('DEBUG-EVAL') + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) + return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -54,6 +58,7 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] + if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -61,45 +66,55 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) ast = a2 env = let_env - # Continue loop (TCO) + continue # TCO elif "quote" == a0: return ast[1] elif "quasiquote" == a0: - ast = quasiquote(ast[1]); - # Continue loop (TCO) + ast = quasiquote(ast[1]) + continue # TCO elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] - # Continue loop (TCO) + continue # TCO elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: - if len(ast) > 3: ast = ast[3] - else: ast = None + if len(ast) > 3: + ast = ast[3] + continue # TCO + else: + return None else: ast = a2 - # Continue loop (TCO) + continue # TCO elif "fn*" == a0: a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - f = EVAL(a0, env) + def fn(*args): + return EVAL(a2, Env(env, a1, args)) + fn.__ast__ = a2 + fn.__gen_env__ = lambda args: Env(env, a1, args) + return fn + + f = EVAL(a0, env) + if types._function_Q(f): args = ast[1:] if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) + env = f.__gen_env__(EVAL(a, env) for a in args) + continue # TCO else: return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') # print -def PRINT(exp): - return printer._pr_str(exp) +PRINT = printer._pr_str # repl repl_env = Env() @@ -109,11 +124,11 @@ def REP(str): # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) -repl_env.set(types._symbol('*ARGV*'), types._list(*sys.argv[2:])) +repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") +REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') if len(sys.argv) >= 2: REP('(load-file "' + sys.argv[1] + '")') @@ -123,9 +138,11 @@ def REP(str): while True: try: line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue print(REP(line)) + except EOFError: + print() + break except reader.Blank: continue - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) + except Exception: + # See tests/step5_tco.mal in this directory. + print("".join(traceback.format_exception(*sys.exc_info())[0:100])) diff --git a/impls/python/step8_macros.py b/impls/python/step8_macros.py index 25044b5235..604b779534 100644 --- a/impls/python/step8_macros.py +++ b/impls/python/step8_macros.py @@ -7,43 +7,47 @@ import core # read -def READ(str): - return reader.read_str(str) +READ = reader.read_str # eval def qq_loop(acc, elt): - if types._list_Q(elt) and len(elt) == 2 and elt[0] == u'splice-unquote': - return types._list(types._symbol(u'concat'), elt[1], acc) + if types._list_Q(elt) \ + and len(elt) == 2 \ + and types._symbol_Q(elt[0]) \ + and elt[0] == 'splice-unquote': + return types._list(types._symbol('concat'), elt[1], acc) else: - return types._list(types._symbol(u'cons'), quasiquote(elt), acc) + return types._list(types._symbol('cons'), quasiquote(elt), acc) def qq_foldr(seq): return functools.reduce(qq_loop, reversed(seq), types._list()) def quasiquote(ast): if types._list_Q(ast): - if len(ast) == 2 and ast[0] == u'unquote': + if len(ast) == 2 \ + and types._symbol_Q(ast[0]) \ + and ast[0] == 'unquote': return ast[1] else: return qq_foldr(ast) elif types._hash_map_Q(ast) or types._symbol_Q(ast): - return types._list(types._symbol(u'quote'), ast) - elif types._vector_Q (ast): - return types._list(types._symbol(u'vec'), qq_foldr(ast)) + return types._list(types._symbol('quote'), ast) + elif types._vector_Q(ast): + return types._list(types._symbol('vec'), qq_foldr(ast)) else: return ast def EVAL(ast, env): while True: - dbgeval = env.get_or_nil('DEBUG-EVAL') + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) + return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -54,6 +58,7 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] + if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -61,52 +66,63 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) ast = a2 env = let_env - # Continue loop (TCO) + continue # TCO elif "quote" == a0: return ast[1] elif "quasiquote" == a0: - ast = quasiquote(ast[1]); - # Continue loop (TCO) + ast = quasiquote(ast[1]) + continue # TCO elif 'defmacro!' == a0: - func = types._clone(EVAL(ast[2], env)) + func = EVAL(ast[2], env) + func = types._clone(func) func._ismacro_ = True return env.set(ast[1], func) elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] - # Continue loop (TCO) + continue # TCO elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: - if len(ast) > 3: ast = ast[3] - else: ast = None + if len(ast) > 3: + ast = ast[3] + continue # TCO + else: + return None else: ast = a2 - # Continue loop (TCO) + continue # TCO elif "fn*" == a0: a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - f = EVAL(a0, env) + def fn(*args): + return EVAL(a2, Env(env, a1, args)) + fn.__ast__ = a2 + fn.__gen_env__ = lambda args: Env(env, a1, args) + return fn + + f = EVAL(a0, env) + if types._function_Q(f): args = ast[1:] if hasattr(f, '_ismacro_'): ast = f(*args) continue # TCO if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) + env = f.__gen_env__(EVAL(a, env) for a in args) + continue # TCO else: return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') # print -def PRINT(exp): - return printer._pr_str(exp) +PRINT = printer._pr_str # repl repl_env = Env() @@ -116,12 +132,16 @@ def REP(str): # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) -repl_env.set(types._symbol('*ARGV*'), types._list(*sys.argv[2:])) +repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") -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('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') +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)))))))""") if len(sys.argv) >= 2: REP('(load-file "' + sys.argv[1] + '")') @@ -131,9 +151,11 @@ def REP(str): while True: try: line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue print(REP(line)) + except EOFError: + print() + break except reader.Blank: continue - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) + except Exception: + # See tests/step5_tco.mal in this directory. + print("".join(traceback.format_exception(*sys.exc_info())[0:100])) diff --git a/impls/python/step9_try.py b/impls/python/step9_try.py index 17aff4d171..5d149f6b6c 100644 --- a/impls/python/step9_try.py +++ b/impls/python/step9_try.py @@ -7,43 +7,47 @@ import core # read -def READ(str): - return reader.read_str(str) +READ = reader.read_str # eval def qq_loop(acc, elt): - if types._list_Q(elt) and len(elt) == 2 and elt[0] == u'splice-unquote': - return types._list(types._symbol(u'concat'), elt[1], acc) + if types._list_Q(elt) \ + and len(elt) == 2 \ + and types._symbol_Q(elt[0]) \ + and elt[0] == 'splice-unquote': + return types._list(types._symbol('concat'), elt[1], acc) else: - return types._list(types._symbol(u'cons'), quasiquote(elt), acc) + return types._list(types._symbol('cons'), quasiquote(elt), acc) def qq_foldr(seq): return functools.reduce(qq_loop, reversed(seq), types._list()) def quasiquote(ast): if types._list_Q(ast): - if len(ast) == 2 and ast[0] == u'unquote': + if len(ast) == 2 \ + and types._symbol_Q(ast[0]) \ + and ast[0] == 'unquote': return ast[1] else: return qq_foldr(ast) elif types._hash_map_Q(ast) or types._symbol_Q(ast): - return types._list(types._symbol(u'quote'), ast) - elif types._vector_Q (ast): - return types._list(types._symbol(u'vec'), qq_foldr(ast)) + return types._list(types._symbol('quote'), ast) + elif types._vector_Q(ast): + return types._list(types._symbol('vec'), qq_foldr(ast)) else: return ast def EVAL(ast, env): while True: - dbgeval = env.get_or_nil('DEBUG-EVAL') + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) + return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -54,6 +58,7 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] + if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -61,28 +66,27 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) ast = a2 env = let_env - # Continue loop (TCO) + continue # TCO elif "quote" == a0: return ast[1] elif "quasiquote" == a0: - ast = quasiquote(ast[1]); - # Continue loop (TCO) + ast = quasiquote(ast[1]) + continue # TCO elif 'defmacro!' == a0: - func = types._clone(EVAL(ast[2], env)) + func = EVAL(ast[2], env) + func = types._clone(func) func._ismacro_ = True return env.set(ast[1], func) - elif "py!*" == a0: - exec(compile(ast[1], '', 'single'), globals()) - return None elif "try*" == a0: if len(ast) < 3: - return EVAL(ast[1], env) - a1, a2 = ast[1], ast[2] - if a2[0] == "catch*": + ast = ast[1] + continue # TCO + else: + a1, a2 = ast[1], ast[2] err = None try: return EVAL(a1, env) @@ -91,41 +95,51 @@ def EVAL(ast, env): except Exception as exc: err = exc.args[0] catch_env = Env(env, [a2[1]], [err]) - return EVAL(a2[2], catch_env) - else: - return EVAL(a1, env); + ast = a2[2] + env = catch_env + continue # TCO elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] - # Continue loop (TCO) + continue # TCO elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: - if len(ast) > 3: ast = ast[3] - else: ast = None + if len(ast) > 3: + ast = ast[3] + continue # TCO + else: + return None else: ast = a2 - # Continue loop (TCO) + continue # TCO elif "fn*" == a0: a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - f = EVAL(a0, env) + def fn(*args): + return EVAL(a2, Env(env, a1, args)) + fn.__ast__ = a2 + fn.__gen_env__ = lambda args: Env(env, a1, args) + return fn + + f = EVAL(a0, env) + if types._function_Q(f): args = ast[1:] if hasattr(f, '_ismacro_'): ast = f(*args) continue # TCO if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) + env = f.__gen_env__(EVAL(a, env) for a in args) + continue # TCO else: return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') # print -def PRINT(exp): - return printer._pr_str(exp) +PRINT = printer._pr_str # repl repl_env = Env() @@ -135,12 +149,16 @@ def REP(str): # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) -repl_env.set(types._symbol('*ARGV*'), types._list(*sys.argv[2:])) +repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) # core.mal: defined using the language itself REP("(def! not (fn* (a) (if a false true)))") -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") -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('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') +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)))))))""") if len(sys.argv) >= 2: REP('(load-file "' + sys.argv[1] + '")') @@ -150,11 +168,13 @@ def REP(str): while True: try: line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue print(REP(line)) + except EOFError: + print() + break except reader.Blank: continue except types.MalException as e: print("Error:", printer._pr_str(e.object)) - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) + except Exception: + # See tests/step5_tco.mal in this directory. + print("".join(traceback.format_exception(*sys.exc_info())[0:100])) diff --git a/impls/python/stepA_mal.py b/impls/python/stepA_mal.py index b8455ac105..4560b0896b 100644 --- a/impls/python/stepA_mal.py +++ b/impls/python/stepA_mal.py @@ -7,43 +7,47 @@ import core # read -def READ(str): - return reader.read_str(str) +READ = reader.read_str # eval def qq_loop(acc, elt): - if types._list_Q(elt) and len(elt) == 2 and elt[0] == u'splice-unquote': - return types._list(types._symbol(u'concat'), elt[1], acc) + if types._list_Q(elt) \ + and len(elt) == 2 \ + and types._symbol_Q(elt[0]) \ + and elt[0] == 'splice-unquote': + return types._list(types._symbol('concat'), elt[1], acc) else: - return types._list(types._symbol(u'cons'), quasiquote(elt), acc) + return types._list(types._symbol('cons'), quasiquote(elt), acc) def qq_foldr(seq): return functools.reduce(qq_loop, reversed(seq), types._list()) def quasiquote(ast): if types._list_Q(ast): - if len(ast) == 2 and ast[0] == u'unquote': + if len(ast) == 2 \ + and types._symbol_Q(ast[0]) \ + and ast[0] == 'unquote': return ast[1] else: return qq_foldr(ast) elif types._hash_map_Q(ast) or types._symbol_Q(ast): - return types._list(types._symbol(u'quote'), ast) - elif types._vector_Q (ast): - return types._list(types._symbol(u'vec'), qq_foldr(ast)) + return types._list(types._symbol('quote'), ast) + elif types._vector_Q(ast): + return types._list(types._symbol('vec'), qq_foldr(ast)) else: return ast def EVAL(ast, env): while True: - dbgeval = env.get_or_nil('DEBUG-EVAL') + dbgeval = env.get(types._symbol('DEBUG-EVAL'), return_nil=True) if dbgeval is not None and dbgeval is not False: print('EVAL: ' + printer._pr_str(ast)) if types._symbol_Q(ast): return env.get(ast) elif types._vector_Q(ast): - return types._vector(*map(lambda a: EVAL(a, env), ast)) + return types.Vector(EVAL(a, env) for a in ast) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) elif not types._list_Q(ast): @@ -54,6 +58,7 @@ def EVAL(ast, env): if len(ast) == 0: return ast a0 = ast[0] + if types._symbol_Q(a0): if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -61,18 +66,19 @@ def EVAL(ast, env): elif "let*" == a0: a1, a2 = ast[1], ast[2] let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) + for k, v in types.asPairs(a1): + let_env.set(k, EVAL(v, let_env)) ast = a2 env = let_env - # Continue loop (TCO) + continue # TCO elif "quote" == a0: return ast[1] elif "quasiquote" == a0: - ast = quasiquote(ast[1]); - # Continue loop (TCO) + ast = quasiquote(ast[1]) + continue # TCO elif 'defmacro!' == a0: - func = types._clone(EVAL(ast[2], env)) + func = EVAL(ast[2], env) + func = types._clone(func) func._ismacro_ = True return env.set(ast[1], func) elif "py!*" == a0: @@ -86,9 +92,10 @@ def EVAL(ast, env): return f(*el) elif "try*" == a0: if len(ast) < 3: - return EVAL(ast[1], env) - a1, a2 = ast[1], ast[2] - if a2[0] == "catch*": + ast = ast[1] + continue # TCO + else: + a1, a2 = ast[1], ast[2] err = None try: return EVAL(a1, env) @@ -97,41 +104,51 @@ def EVAL(ast, env): except Exception as exc: err = exc.args[0] catch_env = Env(env, [a2[1]], [err]) - return EVAL(a2[2], catch_env) - else: - return EVAL(a1, env); + ast = a2[2] + env = catch_env + continue # TCO elif "do" == a0: for i in range(1, len(ast)-1): EVAL(ast[i], env) ast = ast[-1] - # Continue loop (TCO) + continue # TCO elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) if cond is None or cond is False: - if len(ast) > 3: ast = ast[3] - else: ast = None + if len(ast) > 3: + ast = ast[3] + continue # TCO + else: + return None else: ast = a2 - # Continue loop (TCO) + continue # TCO elif "fn*" == a0: a1, a2 = ast[1], ast[2] - return types._function(EVAL, Env, a2, env, a1) - else: - f = EVAL(a0, env) + def fn(*args): + return EVAL(a2, Env(env, a1, args)) + fn.__ast__ = a2 + fn.__gen_env__ = lambda args: Env(env, a1, args) + return fn + + f = EVAL(a0, env) + if types._function_Q(f): args = ast[1:] if hasattr(f, '_ismacro_'): ast = f(*args) continue # TCO if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) + env = f.__gen_env__(EVAL(a, env) for a in args) + continue # TCO else: return f(*(EVAL(a, env) for a in args)) + else: + raise Exception('Can only apply functions') # print -def PRINT(exp): - return printer._pr_str(exp) +PRINT = printer._pr_str # repl repl_env = Env() @@ -141,28 +158,34 @@ def REP(str): # core.py: defined using python for k, v in core.ns.items(): repl_env.set(types._symbol(k), v) repl_env.set(types._symbol('eval'), lambda ast: EVAL(ast, repl_env)) -repl_env.set(types._symbol('*ARGV*'), types._list(*sys.argv[2:])) +repl_env.set(types._symbol('*ARGV*'), types.List(sys.argv[2:])) # core.mal: defined using the language itself -REP("(def! *host-language* \"python\")") +REP('(def! *host-language* "python")') REP("(def! not (fn* (a) (if a false true)))") -REP("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") -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('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') +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)))))))""") if len(sys.argv) >= 2: REP('(load-file "' + sys.argv[1] + '")') sys.exit(0) # repl loop -REP("(println (str \"Mal [\" *host-language* \"]\"))") +REP('(println (str "Mal [" *host-language* "]"))') while True: try: line = mal_readline.readline("user> ") - if line == None: break - if line == "": continue print(REP(line)) + except EOFError: + print() + break except reader.Blank: continue except types.MalException as e: print("Error:", printer._pr_str(e.object)) - except Exception as e: - print("".join(traceback.format_exception(*sys.exc_info()))) + except Exception: + # See tests/step5_tco.mal in this directory. + print("".join(traceback.format_exception(*sys.exc_info())[0:100])) From 0615ae7790e360ddccb6fb470037d41bb95be01c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Fri, 9 Aug 2024 23:53:19 +0800 Subject: [PATCH 079/129] vbs: rename cy20lin's runtest.py to runtest_backup.py --- runtest.py => runtest_backup.py | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename runtest.py => runtest_backup.py (100%) mode change 100755 => 100644 diff --git a/runtest.py b/runtest_backup.py old mode 100755 new mode 100644 similarity index 100% rename from runtest.py rename to runtest_backup.py From 01fbfa2bd6e9e58f6fd3639df523a6580b367ced Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Fri, 9 Aug 2024 23:53:43 +0800 Subject: [PATCH 080/129] vbs: get the runtest.py from `runtest-no-pty-no-echo` branch --- runtest.py | 353 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 353 insertions(+) create mode 100644 runtest.py diff --git a/runtest.py b/runtest.py new file mode 100644 index 0000000000..6e2f5d088a --- /dev/null +++ b/runtest.py @@ -0,0 +1,353 @@ +#!/usr/bin/env python + +from __future__ import print_function +import os, sys, re +import argparse, time +import signal, atexit + +from subprocess import Popen, STDOUT, PIPE +from select import select + +# Pseudo-TTY and terminal manipulation +import pty, array, fcntl, termios + +IS_PY_3 = sys.version_info[0] == 3 + +debug_file = None +log_file = None + +def debug(data): + if debug_file: + debug_file.write(data) + debug_file.flush() + +def log(data, end='\n'): + if log_file: + log_file.write(data + end) + log_file.flush() + print(data, end=end) + sys.stdout.flush() + +sep = "\n" +rundir = None + +parser = argparse.ArgumentParser( + description="Run a test file against a Mal implementation") +parser.add_argument('--rundir', + help="change to the directory before running tests") +parser.add_argument('--start-timeout', default=10, type=int, + help="default timeout for initial prompt") +parser.add_argument('--test-timeout', default=20, type=int, + help="default timeout for each individual test action") +parser.add_argument('--pre-eval', default=None, type=str, + help="Mal code to evaluate prior to running the test") +parser.add_argument('--no-pty', action='store_true', + help="Use direct pipes instead of pseudo-tty") +parser.add_argument('--log-file', type=str, + help="Write messages to the named file in addition the screen") +parser.add_argument('--debug-file', type=str, + help="Write all test interaction the named file") +parser.add_argument('--hard', action='store_true', + help="Turn soft tests (soft, deferrable, optional) into hard failures") + +# Control whether deferrable and optional tests are executed +parser.add_argument('--deferrable', dest='deferrable', action='store_true', + help="Enable deferrable tests that follow a ';>>> deferrable=True'") +parser.add_argument('--no-deferrable', dest='deferrable', action='store_false', + help="Disable deferrable tests that follow a ';>>> deferrable=True'") +parser.set_defaults(deferrable=True) +parser.add_argument('--optional', dest='optional', action='store_true', + help="Enable optional tests that follow a ';>>> optional=True'") +parser.add_argument('--no-optional', dest='optional', action='store_false', + help="Disable optional tests that follow a ';>>> optional=True'") +parser.set_defaults(optional=True) + +parser.add_argument('test_file', type=str, + help="a test file formatted as with mal test data") +parser.add_argument('mal_cmd', nargs="*", + help="Mal implementation command line. Use '--' to " + "specify a Mal command line with dashed options.") +parser.add_argument('--crlf', dest='crlf', action='store_true', + help="Write \\r\\n instead of \\n to the input") + +class Runner(): + def __init__(self, args, no_pty=False, line_break="\n"): + #print "args: %s" % repr(args) + self.no_pty = no_pty + + # Cleanup child process on exit + atexit.register(self.cleanup) + + self.p = None + env = os.environ + env['TERM'] = 'dumb' + env['INPUTRC'] = '/dev/null' + env['PERL_RL'] = 'false' + if no_pty: + self.p = Popen(args, bufsize=0, + stdin=PIPE, stdout=PIPE, stderr=STDOUT, + preexec_fn=os.setsid, + env=env) + self.stdin = self.p.stdin + self.stdout = self.p.stdout + else: + # provide tty to get 'interactive' readline to work + master, slave = pty.openpty() + + # Set terminal size large so that readline will not send + # ANSI/VT escape codes when the lines are long. + buf = array.array('h', [100, 200, 0, 0]) + fcntl.ioctl(master, termios.TIOCSWINSZ, buf, True) + + self.p = Popen(args, bufsize=0, + stdin=slave, stdout=slave, stderr=STDOUT, + preexec_fn=os.setsid, + env=env) + # Now close slave so that we will get an exception from + # read when the child exits early + # http://stackoverflow.com/questions/11165521 + os.close(slave) + self.stdin = os.fdopen(master, 'r+b', 0) + self.stdout = self.stdin + + #print "started" + self.buf = "" + self.last_prompt = "" + + self.line_break = line_break + + def read_to_prompt(self, prompts, timeout): + end_time = time.time() + timeout + while time.time() < end_time: + [outs,_,_] = select([self.stdout], [], [], 1) + if self.stdout in outs: + new_data = self.stdout.read(1) + new_data = new_data.decode("latin1") if IS_PY_3 else new_data + #print("new_data: '%s'" % new_data) + debug(new_data) + # Perform newline cleanup + self.buf += new_data.replace("\r", "") + for prompt in prompts: + regexp = re.compile(prompt) + match = regexp.search(self.buf) + if match: + end = match.end() + buf = self.buf[0:match.start()] + self.buf = self.buf[end:] + self.last_prompt = prompt + return buf + return None + + def writeline(self, str): + def _to_bytes(s): + return bytes(s, "latin1") if IS_PY_3 else s + + self.stdin.write(_to_bytes(str.replace('\r', '\x16\r') + self.line_break)) + + def cleanup(self): + #print "cleaning up" + if self.p: + try: + os.killpg(self.p.pid, signal.SIGTERM) + except OSError: + pass + self.p = None + +class TestReader: + def __init__(self, test_file): + self.line_num = 0 + f = open(test_file, newline='') if IS_PY_3 else open(test_file) + self.data = f.read().split('\n') + self.soft = False + self.deferrable = False + self.optional = False + + def next(self): + self.msg = None + self.form = None + self.out = "" + self.ret = None + + while self.data: + self.line_num += 1 + line = self.data.pop(0) + if re.match(r"^\s*$", line): # blank line + continue + elif line[0:3] == ";;;": # ignore comment + continue + elif line[0:2] == ";;": # output comment + self.msg = line[3:] + return True + elif line[0:5] == ";>>> ": # settings/commands + settings = {} + exec(line[5:], {}, settings) + if 'soft' in settings: + self.soft = settings['soft'] + if 'deferrable' in settings and settings['deferrable']: + self.deferrable = "\nSkipping deferrable and optional tests" + return True + if 'optional' in settings and settings['optional']: + self.optional = "\nSkipping optional tests" + return True + continue + elif line[0:1] == ";": # unexpected comment + raise Exception("Test data error at line %d:\n%s" % (self.line_num, line)) + self.form = line # the line is a form to send + + # Now find the output and return value + while self.data: + line = self.data[0] + if line[0:3] == ";=>": + self.ret = line[3:] + self.line_num += 1 + self.data.pop(0) + break + elif line[0:2] == ";/": + self.out = self.out + line[2:] + sep + self.line_num += 1 + self.data.pop(0) + else: + self.ret = "" + break + if self.ret != None: break + + if self.out[-1:] == sep and not self.ret: + # If there is no return value, output should not end in + # separator + self.out = self.out[0:-1] + return self.form + +args = parser.parse_args(sys.argv[1:]) +# Workaround argparse issue with two '--' on command line +if sys.argv.count('--') > 0: + args.mal_cmd = sys.argv[sys.argv.index('--')+1:] + +if args.rundir: os.chdir(args.rundir) + +if args.log_file: log_file = open(args.log_file, "a") +if args.debug_file: debug_file = open(args.debug_file, "a") + +r = Runner(args.mal_cmd, no_pty=args.no_pty, line_break="\r\n" if args.crlf else "\n") +t = TestReader(args.test_file) + + +def assert_prompt(runner, prompts, timeout): + # Wait for the initial prompt + header = runner.read_to_prompt(prompts, timeout=timeout) + if not header == None: + if header: + log("Started with:\n%s" % header) + else: + log("Did not receive one of following prompt(s): %s" % repr(prompts)) + log(" Got : %s" % repr(r.buf)) + sys.exit(1) + + +# Wait for the initial prompt +try: + assert_prompt(r, ['[^\\s()<>]+> '], args.start_timeout) +except: + _, exc, _ = sys.exc_info() + log("\nException: %s" % repr(exc)) + log("Output before exception:\n%s" % r.buf) + sys.exit(1) + +# Send the pre-eval code if any +if args.pre_eval: + sys.stdout.write("RUNNING pre-eval: %s" % args.pre_eval) + r.writeline(args.pre_eval) + assert_prompt(r, ['[^\\s()<>]+> '], args.test_timeout) + +test_cnt = 0 +pass_cnt = 0 +fail_cnt = 0 +soft_fail_cnt = 0 +failures = [] + +class TestTimeout(Exception): + pass + +while t.next(): + if args.deferrable == False and t.deferrable: + log(t.deferrable) + break + + if args.optional == False and t.optional: + log(t.optional) + break + + if t.msg != None: + log(t.msg) + continue + + if t.form == None: continue + + log("TEST: %s -> [%s,%s]" % (repr(t.form), repr(t.out), t.ret), end='') + + if args.no_pty: + # Do not assume the input forms (and newline) are echo'd to stdout + expects = ["%s%s" % (t.out, re.escape(t.ret))] + else: + # The repeated form is to get around an occasional OS X issue + # where the form is repeated. + # https://github.com/kanaka/mal/issues/30 + expects = [".*%s%s%s" % (sep, t.out, re.escape(t.ret)), + ".*%s.*%s%s%s" % (sep, sep, t.out, re.escape(t.ret))] + + r.writeline(t.form) + try: + test_cnt += 1 + res = r.read_to_prompt(['\r\n[^\\s()<>]+> ', '\n[^\\s()<>]+> '], + timeout=args.test_timeout) + #print "%s,%s,%s" % (idx, repr(p.before), repr(p.after)) + if (res == None): + log(" -> TIMEOUT (line %d)" % t.line_num) + raise TestTimeout("TIMEOUT (line %d)" % t.line_num) + elif (t.ret == "" and t.out == ""): + log(" -> SUCCESS (result ignored)") + pass_cnt += 1 + elif next((e for e in expects if re.search(e, res, re.S)), False): + log(" -> SUCCESS") + pass_cnt += 1 + else: + if t.soft and not args.hard: + log(" -> SOFT FAIL (line %d):" % t.line_num) + soft_fail_cnt += 1 + fail_type = "SOFT " + else: + log(" -> FAIL (line %d):" % t.line_num) + fail_cnt += 1 + fail_type = "" + log(" Expected : %s" % repr(expects[0])) + log(" Got : %s" % repr(res)) + failed_test = """%sFAILED TEST (line %d): %s -> [%s,%s]: + Expected : %s + Got : %s""" % (fail_type, t.line_num, t.form, repr(t.out), + t.ret, repr(expects[0]), repr(res)) + failures.append(failed_test) + except: + _, exc, _ = sys.exc_info() + log("\nException: %s" % repr(exc)) + log("Output before exception:\n%s" % r.buf) + sys.exit(1) + +if len(failures) > 0: + log("\nFAILURES:") + for f in failures: + log(f) + +results = """ +TEST RESULTS (for %s): + %3d: soft failing tests + %3d: failing tests + %3d: passing tests + %3d: total tests +""" % (args.test_file, soft_fail_cnt, fail_cnt, + pass_cnt, test_cnt) +log(results) + +debug("\n") # add some separate to debug log + +if fail_cnt > 0: + sys.exit(1) +sys.exit(0) From b3ba0426cba4cd5e6ecdd167fc459fd60895c8ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Fri, 9 Aug 2024 23:55:01 +0800 Subject: [PATCH 081/129] vbs: Merge branch 'master' of https://github.com/OldLiu001/mal From 9cb13543db47a80393260b531da37d69a5c0232c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 00:05:36 +0800 Subject: [PATCH 082/129] vbs: append print to check out the cmdline --- impls/vbs/run | 4 ++-- runtest.py | 1 + 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/impls/vbs/run b/impls/vbs/run index 4d1d7d43b9..069a90e7ef 100644 --- a/impls/vbs/run +++ b/impls/vbs/run @@ -1,2 +1,2 @@ -#!/bin/bash -exec cscript -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" \ No newline at end of file +#!/bin/bash +exec cscript.exe -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" \ No newline at end of file diff --git a/runtest.py b/runtest.py index 6e2f5d088a..c8017abf2f 100644 --- a/runtest.py +++ b/runtest.py @@ -84,6 +84,7 @@ def __init__(self, args, no_pty=False, line_break="\n"): env['INPUTRC'] = '/dev/null' env['PERL_RL'] = 'false' if no_pty: + print(args) self.p = Popen(args, bufsize=0, stdin=PIPE, stdout=PIPE, stderr=STDOUT, preexec_fn=os.setsid, From 5ba977ba4cea8b2e7389ee6412a48a6094169f28 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 00:06:08 +0800 Subject: [PATCH 083/129] vbs: remove debug print --- runtest.py | 1 - 1 file changed, 1 deletion(-) diff --git a/runtest.py b/runtest.py index c8017abf2f..6e2f5d088a 100644 --- a/runtest.py +++ b/runtest.py @@ -84,7 +84,6 @@ def __init__(self, args, no_pty=False, line_break="\n"): env['INPUTRC'] = '/dev/null' env['PERL_RL'] = 'false' if no_pty: - print(args) self.p = Popen(args, bufsize=0, stdin=PIPE, stdout=PIPE, stderr=STDOUT, preexec_fn=os.setsid, From 4eecc1246923c8794dbf1081a96ccdbad1702f7a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 07:46:40 +0800 Subject: [PATCH 084/129] vbs: try `exec stdbuf -o0 -e0 ` --- impls/vbs/run | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/impls/vbs/run b/impls/vbs/run index 069a90e7ef..c77a9667f1 100644 --- a/impls/vbs/run +++ b/impls/vbs/run @@ -1,2 +1,2 @@ #!/bin/bash -exec cscript.exe -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" \ No newline at end of file +exec stdbuf -o0 -e0 cscript.exe -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" \ No newline at end of file From 52e9f209a2f3b2206458ec64503c0426e000e2b8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 08:55:43 +0800 Subject: [PATCH 085/129] vbs: Consider introducing the MAL_VBS_IMPL_NO_STDERR environment variable --- impls/vbs/run | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/impls/vbs/run b/impls/vbs/run index c77a9667f1..0eb329b21c 100644 --- a/impls/vbs/run +++ b/impls/vbs/run @@ -1,2 +1,2 @@ #!/bin/bash -exec stdbuf -o0 -e0 cscript.exe -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" \ No newline at end of file +MAL_VBS_IMPL_NO_STDERR=1 cscript.exe -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" \ No newline at end of file From 51946c4e8720266712c331a18491dc07b61ddc3d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 09:19:54 +0800 Subject: [PATCH 086/129] vbs: use "2>&1" to combine stderr -> stdout --- impls/vbs/run | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/impls/vbs/run b/impls/vbs/run index 0eb329b21c..686f514bc2 100644 --- a/impls/vbs/run +++ b/impls/vbs/run @@ -1,2 +1,4 @@ #!/bin/bash -MAL_VBS_IMPL_NO_STDERR=1 cscript.exe -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" \ No newline at end of file +# MAL_VBS_IMPL_NO_STDERR=1 cscript.exe -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" +# cmd.exe /c "set MAL_VBS_IMPL_NO_STDERR=1 & cscript -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}"" +cmd.exe /c "cscript -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" 2>&1" From 12f3b86829961f7d81914e1aa335520b7f8eb524 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 10:05:53 +0800 Subject: [PATCH 087/129] vbs: remove some comments --- impls/vbs/run | 2 -- 1 file changed, 2 deletions(-) diff --git a/impls/vbs/run b/impls/vbs/run index 686f514bc2..a369ab84c2 100644 --- a/impls/vbs/run +++ b/impls/vbs/run @@ -1,4 +1,2 @@ #!/bin/bash -# MAL_VBS_IMPL_NO_STDERR=1 cscript.exe -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" -# cmd.exe /c "set MAL_VBS_IMPL_NO_STDERR=1 & cscript -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}"" cmd.exe /c "cscript -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" 2>&1" From 3d6ef27a3c01db9798e228b80e200d05a0141072 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 10:16:14 +0800 Subject: [PATCH 088/129] vbs: Unify newlines to LF for fix step6 slurp's error --- impls/vbs/printer.vbs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/impls/vbs/printer.vbs b/impls/vbs/printer.vbs index fd78defe27..0208232f29 100644 --- a/impls/vbs/printer.vbs +++ b/impls/vbs/printer.vbs @@ -87,7 +87,9 @@ End Function Function EscapeString(strRaw) EscapeString = strRaw EscapeString = Replace(EscapeString, "\", "\\") - EscapeString = Replace(EscapeString, vbCrLf, "\n") + EscapeString = Replace(EscapeString, vbCrLf, vbLf) + EscapeString = Replace(EscapeString, vbCr, vbLf) + EscapeString = Replace(EscapeString, vbLf, "\n") EscapeString = Replace(EscapeString, """", "\""") EscapeString = """" & EscapeString & """" End Function From 3d32d0a32cf6f8ca15100ae8fb9ba89a59ec9b85 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 10:42:15 +0800 Subject: [PATCH 089/129] vbs: because step6 argv test fail, restore `run` to remove `cmd from it` --- impls/vbs/run | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/impls/vbs/run b/impls/vbs/run index a369ab84c2..63de716ee0 100644 --- a/impls/vbs/run +++ b/impls/vbs/run @@ -1,2 +1,2 @@ #!/bin/bash -cmd.exe /c "cscript -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" 2>&1" +cscript.exe -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" From 3ce94fc4e648d568e38396c4e0d1c80fe7bf1360 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 10:45:21 +0800 Subject: [PATCH 090/129] vbs: Replace All `StdErr` with `StdOut` --- impls/vbs/step3_env.vbs | 4 ++-- impls/vbs/step4_if_fn_do.vbs | 4 ++-- impls/vbs/step5_tco.vbs | 4 ++-- impls/vbs/step6_file.vbs | 4 ++-- impls/vbs/step7_quote.vbs | 4 ++-- impls/vbs/step8_macros.vbs | 4 ++-- impls/vbs/step9_try.vbs | 8 ++++---- impls/vbs/stepA_mal.vbs | 8 ++++---- 8 files changed, 20 insertions(+), 20 deletions(-) diff --git a/impls/vbs/step3_env.vbs b/impls/vbs/step3_env.vbs index eedff1a996..ebc5759bd3 100644 --- a/impls/vbs/step3_env.vbs +++ b/impls/vbs/step3_env.vbs @@ -114,8 +114,8 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description - WScript.StdErr.WriteLine "Exception: " + Err.Description + 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description + WScript.StdOut.WriteLine "Exception: " + Err.Description Else If strRes <> "" Then WScript.Echo strRes diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs index d9cb2e890b..896f88a895 100644 --- a/impls/vbs/step4_if_fn_do.vbs +++ b/impls/vbs/step4_if_fn_do.vbs @@ -128,8 +128,8 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description - WScript.StdErr.WriteLine "Exception: " + Err.Description + 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description + WScript.StdOut.WriteLine "Exception: " + Err.Description Else If strRes <> "" Then WScript.Echo strRes diff --git a/impls/vbs/step5_tco.vbs b/impls/vbs/step5_tco.vbs index 3b77ecac35..06b0baa797 100644 --- a/impls/vbs/step5_tco.vbs +++ b/impls/vbs/step5_tco.vbs @@ -137,8 +137,8 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description - WScript.StdErr.WriteLine "Exception: " + Err.Description + 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description + WScript.StdOut.WriteLine "Exception: " + Err.Description Else If strRes <> "" Then WScript.Echo strRes diff --git a/impls/vbs/step6_file.vbs b/impls/vbs/step6_file.vbs index c7cb37baa8..9096f1c132 100644 --- a/impls/vbs/step6_file.vbs +++ b/impls/vbs/step6_file.vbs @@ -165,8 +165,8 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description - WScript.StdErr.WriteLine "Exception: " + Err.Description + 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description + WScript.StdOut.WriteLine "Exception: " + Err.Description Else If strRes <> "" Then WScript.Echo strRes diff --git a/impls/vbs/step7_quote.vbs b/impls/vbs/step7_quote.vbs index 4dadef08ef..c060962092 100644 --- a/impls/vbs/step7_quote.vbs +++ b/impls/vbs/step7_quote.vbs @@ -289,8 +289,8 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description - WScript.StdErr.WriteLine "Exception: " + Err.Description + 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description + WScript.StdOut.WriteLine "Exception: " + Err.Description Else If strRes <> "" Then WScript.Echo strRes diff --git a/impls/vbs/step8_macros.vbs b/impls/vbs/step8_macros.vbs index ed02107a3d..3b2ab6befd 100644 --- a/impls/vbs/step8_macros.vbs +++ b/impls/vbs/step8_macros.vbs @@ -343,8 +343,8 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description - WScript.StdErr.WriteLine "Exception: " + Err.Description + 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description + WScript.StdOut.WriteLine "Exception: " + Err.Description Else If strRes <> "" Then WScript.Echo strRes diff --git a/impls/vbs/step9_try.vbs b/impls/vbs/step9_try.vbs index 8b4af962e0..75f27104a0 100644 --- a/impls/vbs/step9_try.vbs +++ b/impls/vbs/step9_try.vbs @@ -404,13 +404,13 @@ Sub REPL() strRes = REP(strCode) If Err.Number <> 0 Then If Err.Source = "MThrow" Then - 'WScript.StdErr.WriteLine Err.Source + ": " + _ - WScript.StdErr.WriteLine "Exception: " + _ + 'WScript.StdOut.WriteLine Err.Source + ": " + _ + WScript.StdOut.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 + 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description + WScript.StdOut.WriteLine "Exception: " + Err.Description End If Else If strRes <> "" Then diff --git a/impls/vbs/stepA_mal.vbs b/impls/vbs/stepA_mal.vbs index d6bc3f3d5b..9992cdb72a 100644 --- a/impls/vbs/stepA_mal.vbs +++ b/impls/vbs/stepA_mal.vbs @@ -405,13 +405,13 @@ Sub REPL() strRes = REP(strCode) If Err.Number <> 0 Then If Err.Source = "MThrow" Then - 'WScript.StdErr.WriteLine Err.Source + ": " + _ - WScript.StdErr.WriteLine "Exception: " + _ + 'WScript.StdOut.WriteLine Err.Source + ": " + _ + WScript.StdOut.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 + 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description + WScript.StdOut.WriteLine "Exception: " + Err.Description End If Else If strRes <> "" Then From 2f77a55aa9e7d98b219422a5ea8dc36a28429822 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 10:47:03 +0800 Subject: [PATCH 091/129] vbs: Replace All `StdErr` with `StdOut` 2 --- impls/vbs/step1_read_print.vbs | 4 ++-- impls/vbs/step2_eval.vbs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index 01757b6e14..34e0e55a0f 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -20,8 +20,8 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description - WScript.StdErr.WriteLine "Exception: " + Err.Description + 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description + WScript.StdOut.WriteLine "Exception: " + Err.Description Else If strRes <> "" Then WScript.Echo strRes diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs index 769a342697..43c8c2c514 100644 --- a/impls/vbs/step2_eval.vbs +++ b/impls/vbs/step2_eval.vbs @@ -103,8 +103,8 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description - WScript.StdErr.WriteLine "Exception: " + Err.Description + 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description + WScript.StdOut.WriteLine "Exception: " + Err.Description Else If strRes <> "" Then WScript.Echo strRes From ad29392ca4a496f747981c4d4c9f422008d2346e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 11:23:24 +0800 Subject: [PATCH 092/129] vbs: fix `permission denied` issue by Github Action --- runtest.py | 0 1 file changed, 0 insertions(+), 0 deletions(-) mode change 100644 => 100755 runtest.py diff --git a/runtest.py b/runtest.py old mode 100644 new mode 100755 From 7f04b3382be4081f442f1eda98fa5cdaef1ce6f0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 11:24:59 +0800 Subject: [PATCH 093/129] vbs: comment out other impls to let `Github Action` for `vbs impl` run faster --- IMPLS.yml | 242 +++++++++++++++++++++++++++--------------------------- 1 file changed, 121 insertions(+), 121 deletions(-) diff --git a/IMPLS.yml b/IMPLS.yml index 02a8056ce8..3c17dce5a5 100644 --- a/IMPLS.yml +++ b/IMPLS.yml @@ -1,125 +1,125 @@ IMPL: - - {IMPL: ada} - - {IMPL: ada.2} - - {IMPL: awk} - - {IMPL: bash, NO_SELF_HOST: 1} # step8 timeout - - {IMPL: basic, basic_MODE: cbm, NO_SELF_HOST: 1} # step4 OOM - - {IMPL: basic, basic_MODE: qbasic, NO_SELF_HOST: 1} # step4 OOM - - {IMPL: bbc-basic} - - {IMPL: c} - - {IMPL: c.2} - - {IMPL: cpp} - - {IMPL: coffee} - - {IMPL: cs} - - {IMPL: chuck, NO_SELF_HOST_PERF: 1} # perf OOM - - {IMPL: clojure, clojure_MODE: clj} - - {IMPL: clojure, clojure_MODE: cljs} - - {IMPL: common-lisp} - - {IMPL: crystal} - - {IMPL: d, d_MODE: gdc} - - {IMPL: d, d_MODE: ldc2} - - {IMPL: d, d_MODE: dmd} - - {IMPL: dart} - - {IMPL: elisp} - - {IMPL: elixir} - - {IMPL: elm} - - {IMPL: erlang, NO_SELF_HOST: 1} # step8 OOM - - {IMPL: es6} - - {IMPL: factor} - - {IMPL: fantom} - - {IMPL: fennel} - - {IMPL: forth} - - {IMPL: fsharp} - - {IMPL: go} - - {IMPL: groovy} - - {IMPL: gnu-smalltalk} - - {IMPL: guile} - - {IMPL: haskell} - - {IMPL: haxe, haxe_MODE: neko} - - {IMPL: haxe, haxe_MODE: python} - - {IMPL: haxe, haxe_MODE: cpp, SLOW: 1} - - {IMPL: haxe, haxe_MODE: js} - - {IMPL: hy} - - {IMPL: io, NO_SELF_HOST_PERF: 1} # perf OOM - - {IMPL: janet} - - {IMPL: java} - - {IMPL: java-truffle} - - {IMPL: jq} - - {IMPL: js} - - {IMPL: julia} - - {IMPL: kotlin} - - {IMPL: latex3, NO_PERF: 1, NO_SELF_HOST: 1, SLOW: 1} - - {IMPL: livescript} - - {IMPL: logo} - - {IMPL: lua} - - {IMPL: make, NO_SELF_HOST: 1} # step4 timeout - - {IMPL: mal, MAL_IMPL: js, BUILD_IMPL: js, NO_SELF_HOST: 1} - - {IMPL: mal, MAL_IMPL: js-mal, BUILD_IMPL: js, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} - - {IMPL: mal, MAL_IMPL: nim, BUILD_IMPL: nim, NO_SELF_HOST: 1} - - {IMPL: mal, MAL_IMPL: nim-mal, BUILD_IMPL: nim, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} - - {IMPL: matlab, NO_SELF_HOST_PERF: 1} # Octave, perf timeout - - {IMPL: miniMAL, NO_SELF_HOST_PERF: 1, SLOW: 1} # perf timeout - - {IMPL: nasm, NO_SELF_HOST_PERF: 1} # perf OOM - - {IMPL: nim} - - {IMPL: objpascal} - - {IMPL: objc} - - {IMPL: ocaml} - - {IMPL: perl} - - {IMPL: perl6} - - {IMPL: php} - - {IMPL: picolisp} - - {IMPL: pike} - - {IMPL: plpgsql, NO_SELF_HOST: 1, SLOW: 1} # step3 timeout -# - {IMPL: plsql} - - {IMPL: prolog} - - {IMPL: ps} - - {IMPL: powershell, NO_SELF_HOST_PERF: 1} - - {IMPL: purs} - - {IMPL: python, python_MODE: python2} - - {IMPL: python, python_MODE: python3} - - {IMPL: python.2} - - {IMPL: r} - - {IMPL: racket} - - {IMPL: rexx} - - {IMPL: rpython, SLOW: 1} - - {IMPL: ruby} - - {IMPL: ruby.2} - - {IMPL: rust} - - {IMPL: scala} - - {IMPL: scheme, scheme_MODE: chibi} - - {IMPL: scheme, scheme_MODE: kawa} - - {IMPL: scheme, scheme_MODE: gauche} - - {IMPL: scheme, scheme_MODE: chicken} - - {IMPL: scheme, scheme_MODE: sagittarius} - - {IMPL: scheme, scheme_MODE: cyclone} -# - {IMPL: scheme, scheme_MODE: foment} - - {IMPL: skew} - - {IMPL: sml, sml_MODE: polyml} - - {IMPL: sml, sml_MODE: mlton} - - {IMPL: sml, sml_MODE: mosml} - - {IMPL: tcl} - - {IMPL: ts} - - {IMPL: vala} - - {IMPL: vb} - - {IMPL: vhdl, NO_SELF_HOST_PERF: 1} # perf timeout - - {IMPL: vimscript} - # no self-host perf for wasm due to mac stack overflow - - {IMPL: wasm, wasm_MODE: wasmtime, NO_SELF_HOST_PERF: 1, NO_PERF: 1} - - {IMPL: wasm, wasm_MODE: wasmer, NO_SELF_HOST_PERF: 1, NO_PERF: 1} - #- {IMPL: wasm, wasm_MODE: wax, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions - - {IMPL: wasm, wasm_MODE: node, NO_SELF_HOST_PERF: 1, NO_PERF: 1} - #- {IMPL: wasm, wasm_MODE: warpy, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions - #- {IMPL: wasm, wasm_MODE: wace_libc, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions - - {IMPL: wren} - - {IMPL: xslt} - - {IMPL: yorick} - - {IMPL: zig} +# - {IMPL: ada} +# - {IMPL: ada.2} +# - {IMPL: awk} +# - {IMPL: bash, NO_SELF_HOST: 1} # step8 timeout +# - {IMPL: basic, basic_MODE: cbm, NO_SELF_HOST: 1} # step4 OOM +# - {IMPL: basic, basic_MODE: qbasic, NO_SELF_HOST: 1} # step4 OOM +# - {IMPL: bbc-basic} +# - {IMPL: c} +# - {IMPL: c.2} +# - {IMPL: cpp} +# - {IMPL: coffee} +# - {IMPL: cs} +# - {IMPL: chuck, NO_SELF_HOST_PERF: 1} # perf OOM +# - {IMPL: clojure, clojure_MODE: clj} +# - {IMPL: clojure, clojure_MODE: cljs} +# - {IMPL: common-lisp} +# - {IMPL: crystal} +# - {IMPL: d, d_MODE: gdc} +# - {IMPL: d, d_MODE: ldc2} +# - {IMPL: d, d_MODE: dmd} +# - {IMPL: dart} +# - {IMPL: elisp} +# - {IMPL: elixir} +# - {IMPL: elm} +# - {IMPL: erlang, NO_SELF_HOST: 1} # step8 OOM +# - {IMPL: es6} +# - {IMPL: factor} +# - {IMPL: fantom} +# - {IMPL: fennel} +# - {IMPL: forth} +# - {IMPL: fsharp} +# - {IMPL: go} +# - {IMPL: groovy} +# - {IMPL: gnu-smalltalk} +# - {IMPL: guile} +# - {IMPL: haskell} +# - {IMPL: haxe, haxe_MODE: neko} +# - {IMPL: haxe, haxe_MODE: python} +# - {IMPL: haxe, haxe_MODE: cpp, SLOW: 1} +# - {IMPL: haxe, haxe_MODE: js} +# - {IMPL: hy} +# - {IMPL: io, NO_SELF_HOST_PERF: 1} # perf OOM +# - {IMPL: janet} +# - {IMPL: java} +# - {IMPL: java-truffle} +# - {IMPL: jq} +# - {IMPL: js} +# - {IMPL: julia} +# - {IMPL: kotlin} +# - {IMPL: latex3, NO_PERF: 1, NO_SELF_HOST: 1, SLOW: 1} +# - {IMPL: livescript} +# - {IMPL: logo} +# - {IMPL: lua} +# - {IMPL: make, NO_SELF_HOST: 1} # step4 timeout +# - {IMPL: mal, MAL_IMPL: js, BUILD_IMPL: js, NO_SELF_HOST: 1} +# - {IMPL: mal, MAL_IMPL: js-mal, BUILD_IMPL: js, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} +# - {IMPL: mal, MAL_IMPL: nim, BUILD_IMPL: nim, NO_SELF_HOST: 1} +# - {IMPL: mal, MAL_IMPL: nim-mal, BUILD_IMPL: nim, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} +# - {IMPL: matlab, NO_SELF_HOST_PERF: 1} # Octave, perf timeout +# - {IMPL: miniMAL, NO_SELF_HOST_PERF: 1, SLOW: 1} # perf timeout +# - {IMPL: nasm, NO_SELF_HOST_PERF: 1} # perf OOM +# - {IMPL: nim} +# - {IMPL: objpascal} +# - {IMPL: objc} +# - {IMPL: ocaml} +# - {IMPL: perl} +# - {IMPL: perl6} +# - {IMPL: php} +# - {IMPL: picolisp} +# - {IMPL: pike} +# - {IMPL: plpgsql, NO_SELF_HOST: 1, SLOW: 1} # step3 timeout +# # - {IMPL: plsql} +# - {IMPL: prolog} +# - {IMPL: ps} +# - {IMPL: powershell, NO_SELF_HOST_PERF: 1} +# - {IMPL: purs} +# - {IMPL: python, python_MODE: python2} +# - {IMPL: python, python_MODE: python3} +# - {IMPL: python.2} +# - {IMPL: r} +# - {IMPL: racket} +# - {IMPL: rexx} +# - {IMPL: rpython, SLOW: 1} +# - {IMPL: ruby} +# - {IMPL: ruby.2} +# - {IMPL: rust} +# - {IMPL: scala} +# - {IMPL: scheme, scheme_MODE: chibi} +# - {IMPL: scheme, scheme_MODE: kawa} +# - {IMPL: scheme, scheme_MODE: gauche} +# - {IMPL: scheme, scheme_MODE: chicken} +# - {IMPL: scheme, scheme_MODE: sagittarius} +# - {IMPL: scheme, scheme_MODE: cyclone} +# # - {IMPL: scheme, scheme_MODE: foment} +# - {IMPL: skew} +# - {IMPL: sml, sml_MODE: polyml} +# - {IMPL: sml, sml_MODE: mlton} +# - {IMPL: sml, sml_MODE: mosml} +# - {IMPL: tcl} +# - {IMPL: ts} +# - {IMPL: vala} +# - {IMPL: vb} +# - {IMPL: vhdl, NO_SELF_HOST_PERF: 1} # perf timeout +# - {IMPL: vimscript} +# # no self-host perf for wasm due to mac stack overflow +# - {IMPL: wasm, wasm_MODE: wasmtime, NO_SELF_HOST_PERF: 1, NO_PERF: 1} +# - {IMPL: wasm, wasm_MODE: wasmer, NO_SELF_HOST_PERF: 1, NO_PERF: 1} +# #- {IMPL: wasm, wasm_MODE: wax, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions +# - {IMPL: wasm, wasm_MODE: node, NO_SELF_HOST_PERF: 1, NO_PERF: 1} +# #- {IMPL: wasm, wasm_MODE: warpy, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions +# #- {IMPL: wasm, wasm_MODE: wace_libc, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions +# - {IMPL: wren} +# - {IMPL: xslt} +# - {IMPL: yorick} +# - {IMPL: zig} - # See .travis.yml (for older osx / xcode tests) -# - {IMPL: objc, NO_DOCKER: 1, OS: xcode7}} -# - {IMPL: swift, NO_DOCKER: 1, OS: xcode7.3}} -# - {IMPL: swift3, NO_DOCKER: 1, OS: xcode8}} -# - {IMPL: swift4, NO_DOCKER: 1, OS: xcode10}} - - {IMPL: swift5, NO_DOCKER: 1, OS: macos} +# # See .travis.yml (for older osx / xcode tests) +# # - {IMPL: objc, NO_DOCKER: 1, OS: xcode7}} +# # - {IMPL: swift, NO_DOCKER: 1, OS: xcode7.3}} +# # - {IMPL: swift3, NO_DOCKER: 1, OS: xcode8}} +# # - {IMPL: swift4, NO_DOCKER: 1, OS: xcode10}} +# - {IMPL: swift5, NO_DOCKER: 1, OS: macos} - {IMPL: vbs, NO_DOCKER: 1, OS: windows} From 601f8dcf994d7704521f9e1ca0d8cdb4ae057a60 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 11:34:32 +0800 Subject: [PATCH 094/129] vbs: import `Vampire/setup-wsl` --- .github/workflows/main.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index ea7dd61e3f..f7afb33be3 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -138,6 +138,9 @@ jobs: fail-fast: false matrix: ${{ fromJson(needs.get-matrix.outputs.matrix-windows) }} steps: + - uses: Vampire/setup-wsl@v3 + with: + distribution: ubuntu-24.04 - uses: actions/checkout@v4 - name: Build shell: bash From 1b92b788f469322050b7474e77ff2a66be0dd7f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 11:36:01 +0800 Subject: [PATCH 095/129] vbs: `ubuntu` -> `Ubuntu` --- .github/workflows/main.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index f7afb33be3..89ffd6a0a9 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -140,7 +140,7 @@ jobs: steps: - uses: Vampire/setup-wsl@v3 with: - distribution: ubuntu-24.04 + distribution: Ubuntu-24.04 - uses: actions/checkout@v4 - name: Build shell: bash From bc1d0575d51b529576910f2f553de2ac2cbffcf5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 11:40:12 +0800 Subject: [PATCH 096/129] vbs: use `wsl-bash` instead of `bash` --- .github/workflows/main.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 89ffd6a0a9..6e219577b0 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -143,22 +143,22 @@ jobs: distribution: Ubuntu-24.04 - uses: actions/checkout@v4 - name: Build - shell: bash + shell: wsl-bash run: | export ${{ matrix.IMPL }} ./ci.sh build ${IMPL} - name: Step Tests - shell: bash + shell: wsl-bash run: | export ${{ matrix.IMPL }} ./ci.sh test ${IMPL} - name: Regression Tests - shell: bash + shell: wsl-bash run: | export ${{ matrix.IMPL }} STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} - name: Performance Tests - shell: bash + shell: wsl-bash run: | export ${{ matrix.IMPL }} ./ci.sh perf ${IMPL} From 18aa936083c6fef294ecd5150bcde3f908c23d62 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 11:49:11 +0800 Subject: [PATCH 097/129] vbs: use `wsl-bash` instead of `bash` 2 --- .github/workflows/main.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 6e219577b0..fcb62118e7 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -143,22 +143,22 @@ jobs: distribution: Ubuntu-24.04 - uses: actions/checkout@v4 - name: Build - shell: wsl-bash + shell: wsl-bash {0} run: | export ${{ matrix.IMPL }} ./ci.sh build ${IMPL} - name: Step Tests - shell: wsl-bash + shell: wsl-bash {0} run: | export ${{ matrix.IMPL }} ./ci.sh test ${IMPL} - name: Regression Tests - shell: wsl-bash + shell: wsl-bash {0} run: | export ${{ matrix.IMPL }} STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} - name: Performance Tests - shell: wsl-bash + shell: wsl-bash {0} run: | export ${{ matrix.IMPL }} ./ci.sh perf ${IMPL} From 009dafe9042bd448eb2fbdd622de6c25c3e3dc6a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 12:06:14 +0800 Subject: [PATCH 098/129] vbs: add `.gitattr` to fix action+win+wsl `./ci.sh: line 2: $'\r': command not found` bug --- .gitattributes | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 .gitattributes diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000000..cfe51313e7 --- /dev/null +++ b/.gitattributes @@ -0,0 +1,2 @@ +* text=auto eol=lf +impls/vbs/*.vbs text eol=crlf \ No newline at end of file From a44c5bcfcb7b7b6adb9d8e50908a54b24578584d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 12:35:21 +0800 Subject: [PATCH 099/129] vbs: Use `kali-linux` instead of `Ubuntu-24.0.4` --- .github/workflows/main.yml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index fcb62118e7..092536d787 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -140,7 +140,11 @@ jobs: steps: - uses: Vampire/setup-wsl@v3 with: - distribution: Ubuntu-24.04 + distribution: kali-linux + - name: Install requirements for WSL + shell: wsl-bash {0} + run: | + sudo ln -s /usr/bin/python2 /usr/bin/python - uses: actions/checkout@v4 - name: Build shell: wsl-bash {0} From 6b7b46f4bf11dcc55daae7811f27ca838f4b30ea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 12:41:09 +0800 Subject: [PATCH 100/129] vbs: install `make` for `WSL` --- .github/workflows/main.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 092536d787..94c5e60bce 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -145,6 +145,7 @@ jobs: shell: wsl-bash {0} run: | sudo ln -s /usr/bin/python2 /usr/bin/python + sudo apt install make -y - uses: actions/checkout@v4 - name: Build shell: wsl-bash {0} From 307b0775a2f8e62adca3fb03f4706b21d5f775ee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 12:48:40 +0800 Subject: [PATCH 101/129] vbs: install `python2` for `WSL` --- .github/workflows/main.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 94c5e60bce..68ba4394be 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -144,8 +144,9 @@ jobs: - name: Install requirements for WSL shell: wsl-bash {0} run: | - sudo ln -s /usr/bin/python2 /usr/bin/python sudo apt install make -y + sudo apt install python2 -y + sudo ln -s /usr/bin/python2 /usr/bin/python - uses: actions/checkout@v4 - name: Build shell: wsl-bash {0} From 30ecbdd7f07bc65faa481c07879dbca6856f27ad Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 12:52:13 +0800 Subject: [PATCH 102/129] vbs: `sudo apt update -y` for WSL --- .github/workflows/main.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 68ba4394be..bb1074b70a 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -144,6 +144,7 @@ jobs: - name: Install requirements for WSL shell: wsl-bash {0} run: | + sudo apt update -y sudo apt install make -y sudo apt install python2 -y sudo ln -s /usr/bin/python2 /usr/bin/python From 21a2031ced68f9dcc57639e89d60e30cf2ea6887 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 13:00:04 +0800 Subject: [PATCH 103/129] vbs: test `step6` in `github action` --- .github/workflows/main.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index bb1074b70a..530be32e51 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -163,6 +163,7 @@ jobs: shell: wsl-bash {0} run: | export ${{ matrix.IMPL }} + make "test^vbs^step6" STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} - name: Performance Tests shell: wsl-bash {0} From 478a474735087c4a62be74c33845a048cf3bef4b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 13:04:05 +0800 Subject: [PATCH 104/129] vbs: test step6 `argv_test` in github action 2 --- .github/workflows/main.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 530be32e51..937cca25fd 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -157,13 +157,13 @@ jobs: - name: Step Tests shell: wsl-bash {0} run: | + make "test^vbs^step6" export ${{ matrix.IMPL }} ./ci.sh test ${IMPL} - name: Regression Tests shell: wsl-bash {0} run: | export ${{ matrix.IMPL }} - make "test^vbs^step6" STEP=stepA REGRESS=1 HARD=1 OPTIONAL=0 ./ci.sh test ${IMPL} - name: Performance Tests shell: wsl-bash {0} From 49f7f6c7bb9379eb48944de714fdbffb2c61316b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 13:09:13 +0800 Subject: [PATCH 105/129] vbs: ` test step6 in github action` success --- .github/workflows/main.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 937cca25fd..bb1074b70a 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -157,7 +157,6 @@ jobs: - name: Step Tests shell: wsl-bash {0} run: | - make "test^vbs^step6" export ${{ matrix.IMPL }} ./ci.sh test ${IMPL} - name: Regression Tests From 104ca7f4f5220197e4023947dd789523b688b750 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 13:22:02 +0800 Subject: [PATCH 106/129] vbs: remove `run.cmd` --- impls/vbs/run.cmd | 2 -- 1 file changed, 2 deletions(-) delete mode 100644 impls/vbs/run.cmd diff --git a/impls/vbs/run.cmd b/impls/vbs/run.cmd deleted file mode 100644 index 64a5dad4f2..0000000000 --- a/impls/vbs/run.cmd +++ /dev/null @@ -1,2 +0,0 @@ -@setlocal & @if not defined STEP set STEP=stepA_mal -@cscript -nologo "%~dp0\%STEP%.vbs" %* \ No newline at end of file From d70443337c69de857c319944d2e40f5dde0b6454 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 13:22:20 +0800 Subject: [PATCH 107/129] vbs: remove `runtest_backup.py` --- runtest_backup.py | 448 ---------------------------------------------- 1 file changed, 448 deletions(-) delete mode 100644 runtest_backup.py diff --git a/runtest_backup.py b/runtest_backup.py deleted file mode 100644 index ada6a54231..0000000000 --- a/runtest_backup.py +++ /dev/null @@ -1,448 +0,0 @@ -#!/usr/bin/env python -from __future__ import print_function -import os, sys, re -import argparse, time -import signal, atexit -from subprocess import Popen, STDOUT, PIPE - -IS_PY_3 = sys.version_info[0] == 3 - -if os.name == 'posix': - from select import select -else: - if IS_PY_3: - import threading, queue - from subprocess import TimeoutExpired - else: - import threading - import Queue as queue - -debug_file = None -log_file = None - -def debug(data): - if debug_file: - debug_file.write(data) - debug_file.flush() - -def log(data, end='\n'): - if log_file: - log_file.write(data + end) - log_file.flush() - print(data, end=end) - sys.stdout.flush() - -sep = "\n" -rundir = None - -parser = argparse.ArgumentParser( - description="Run a test file against a Mal implementation") -parser.add_argument('--rundir', - help="change to the directory before running tests") -parser.add_argument('--start-timeout', default=10, type=int, - help="default timeout for initial prompt") -parser.add_argument('--test-timeout', default=20, type=int, - help="default timeout for each individual test action") -parser.add_argument('--pre-eval', default=None, type=str, - help="Mal code to evaluate prior to running the test") -parser.add_argument('--no-pty', action='store_true', - help="Use direct pipes instead of pseudo-tty") -parser.add_argument('--log-file', type=str, - help="Write messages to the named file in addition the screen") -parser.add_argument('--debug-file', type=str, - help="Write all test interaction the named file") -parser.add_argument('--hard', action='store_true', - help="Turn soft tests (soft, deferrable, optional) into hard failures") - -# Control whether deferrable and optional tests are executed -parser.add_argument('--deferrable', dest='deferrable', action='store_true', - help="Enable deferrable tests that follow a ';>>> deferrable=True'") -parser.add_argument('--no-deferrable', dest='deferrable', action='store_false', - help="Disable deferrable tests that follow a ';>>> deferrable=True'") -parser.set_defaults(deferrable=True) -parser.add_argument('--optional', dest='optional', action='store_true', - help="Enable optional tests that follow a ';>>> optional=True'") -parser.add_argument('--no-optional', dest='optional', action='store_false', - help="Disable optional tests that follow a ';>>> optional=True'") -parser.set_defaults(optional=True) - -parser.add_argument('test_file', type=str, - help="a test file formatted as with mal test data") -parser.add_argument('mal_cmd', nargs="*", - help="Mal implementation command line. Use '--' to " - "specify a Mal command line with dashed options.") -parser.add_argument('--crlf', dest='crlf', action='store_true', - help="Write \\r\\n instead of \\n to the input") - -class Runner(): - def __init__(self, args, no_pty=False, line_break="\n"): - #print "args: %s" % repr(args) - self.no_pty = no_pty - - # Cleanup child process on exit - atexit.register(self.cleanup) - - self.p = None - env = os.environ - env['TERM'] = 'dumb' - env['INPUTRC'] = '/dev/null' - env['PERL_RL'] = 'false' - if os.name == 'posix': - if no_pty: - self.p = Popen(args, bufsize=0, - stdin=PIPE, stdout=PIPE, stderr=STDOUT, - preexec_fn=os.setsid, - env=env) - self.stdin = self.p.stdin - self.stdout = self.p.stdout - else: - # Pseudo-TTY and terminal manipulation - import pty, array, fcntl, termios - - # provide tty to get 'interactive' readline to work - master, slave = pty.openpty() - - # Set terminal size large so that readline will not send - # ANSI/VT escape codes when the lines are long. - buf = array.array('h', [100, 200, 0, 0]) - fcntl.ioctl(master, termios.TIOCSWINSZ, buf, True) - - self.p = Popen(args, bufsize=0, - stdin=slave, stdout=slave, stderr=STDOUT, - preexec_fn=os.setsid, - env=env) - # Now close slave so that we will get an exception from - # read when the child exits early - # http://stackoverflow.com/questions/11165521 - os.close(slave) - self.stdin = os.fdopen(master, 'r+b', 0) - self.stdout = self.stdin - elif os.name == 'nt': - if no_pty: - from subprocess import CREATE_NEW_PROCESS_GROUP - - # replace args's forward slashes & append ext name - args[0] = args[0].replace('/', '\\') + '.cmd' - - self.p = Popen(args, bufsize=0, - stdin=PIPE, stdout=PIPE, stderr=STDOUT, - creationflags=CREATE_NEW_PROCESS_GROUP, - env=env) - self.stdin = self.p.stdin - self.stdout = self.p.stdout - else: - raise ValueError('pty not supported on os.name="{}"'.format(os.name)) - else: - if no_pty: - self.p = Popen(args, bufsize=0, - stdin=PIPE, stdout=PIPE, stderr=STDOUT, - env=env) - self.stdin = self.p.stdin - self.stdout = self.p.stdout - else: - raise ValueError('pty not supported on os.name="{}"'.format(os.name)) - - #print "started" - self.buf = "" - self.last_prompt = "" - self.line_break = line_break - - if os.name == 'posix': - self.q = None - self.t = None - else: - self.q = queue.Queue() - self.t = threading.Thread(target=self._reader, args=()) - self.t.daemon = True - self.t.start() - - def _reader(self): - try: - f = self.stdout - ok = True - while ok: - try: - new_data = f.read(1) - if len(new_data) == 0: # EOF - ok = False - except Exception as e: - # catch the read exception and send it to queue - ok = False - new_data = e - self.q.put(new_data) - except: - pass - - def read_to_prompt(self, prompts, timeout, search_prefix=''): - end_time = time.time() + timeout - while True: - current_timeout = max(end_time - time.time(), 0.) - if current_timeout == 0.: - break - if os.name == 'posix': - [outs,_,_] = select([self.stdout], [], [], 1) - if self.stdout not in outs: - continue - new_data = self.stdout.read(1) - - else: - try: - new_data = self.q.get(timeout=current_timeout) - except queue.Empty: - break - if isinstance(new_data, Exception): - raise new_data - if len(new_data) == 0: # EOF - break - new_data = new_data.decode("latin1") if IS_PY_3 else new_data - #print("new_data: '%s'" % new_data) - debug(new_data) - # Perform newline cleanup - self.buf += new_data.replace("\r", "") - for prompt in prompts: - regexp = re.compile(prompt) - match = regexp.search(search_prefix + self.buf) - if match: - start = match.start() - len(search_prefix) - end = match.end() - len(search_prefix) - buf = self.buf[0:start] - self.buf = self.buf[end:] - self.last_prompt = prompt - return buf - # MAYBE we should distinguish EOF from TIMEOUT, - # return None for both cases currently - return None - - def writeline(self, str): - def _to_bytes(s): - return bytes(s, "latin1") if IS_PY_3 else s - if os.name == 'posix': - self.stdin.write(_to_bytes(str.replace('\r', '\x16\r') + self.line_break)) - else: - self.stdin.write(_to_bytes(str + self.line_break)) - - def cleanup(self): - #print "cleaning up" - if self.p: - try: - if os.name == 'posix': - os.killpg(self.p.pid, signal.SIGTERM) - elif os.name == 'nt': - self.p.send_signal(signal.CTRL_BREAK_EVENT) - else: - self.p.terminate() - if IS_PY_3: - try: - self.p.communicate(timeout=1.0) - except TimeoutExpired: - self.p.kill() - except OSError: - pass - self.p = None - self.stdin = None - self.stdout = None - -class TestReader: - def __init__(self, test_file): - self.line_num = 0 - f = open(test_file) - self.data = f.read().split('\n') - self.soft = False - self.deferrable = False - self.optional = False - - def next(self): - self.msg = None - self.form = None - self.out = "" - self.ret = None - - while self.data: - self.line_num += 1 - line = self.data.pop(0) - if re.match(r"^\s*$", line): # blank line - continue - elif line[0:3] == ";;;": # ignore comment - continue - elif line[0:2] == ";;": # output comment - self.msg = line[3:] - return True - elif line[0:5] == ";>>> ": # settings/commands - settings = {} - exec(line[5:], {}, settings) - if 'soft' in settings: - self.soft = settings['soft'] - if 'deferrable' in settings and settings['deferrable']: - self.deferrable = "\nSkipping deferrable and optional tests" - return True - if 'optional' in settings and settings['optional']: - self.optional = "\nSkipping optional tests" - return True - continue - elif line[0:1] == ";": # unexpected comment - raise Exception("Test data error at line %d:\n%s" % (self.line_num, line)) - self.form = line # the line is a form to send - - # Now find the output and return value - while self.data: - line = self.data[0] - if line[0:3] == ";=>": - self.ret = line[3:] - self.line_num += 1 - self.data.pop(0) - break - elif line[0:2] == ";/": - self.out = self.out + line[2:] + sep - self.line_num += 1 - self.data.pop(0) - else: - self.ret = "" - break - if self.ret != None: break - - if self.out[-1:] == sep and not self.ret: - # If there is no return value, output should not end in - # separator - self.out = self.out[0:-1] - return self.form - -args = parser.parse_args(sys.argv[1:]) -# Workaround argparse issue with two '--' on command line -if sys.argv.count('--') > 0: - args.mal_cmd = sys.argv[sys.argv.index('--')+1:] - -if args.rundir: os.chdir(args.rundir) - -if args.log_file: log_file = open(args.log_file, "a") -if args.debug_file: debug_file = open(args.debug_file, "a") - -r = Runner(args.mal_cmd, no_pty=args.no_pty, line_break="\r\n" if args.crlf else "\n") -t = TestReader(args.test_file) - - -def assert_prompt(runner, prompts, timeout): - # Wait for the initial prompt - header = runner.read_to_prompt(prompts, timeout=timeout) - if not header == None: - if header: - log("Started with:\n%s" % header) - else: - log("Did not receive one of following prompt(s): %s" % repr(prompts)) - log(" Got : %s" % repr(r.buf)) - sys.exit(1) - - -# Wait for the initial prompt -try: - assert_prompt(r, ['[^\\s()<>]+> '], args.start_timeout) -except: - _, exc, _ = sys.exc_info() - log("\nException: %s" % repr(exc)) - log("Output before exception:\n%s" % r.buf) - sys.exit(1) - -# Send the pre-eval code if any -if args.pre_eval: - sys.stdout.write("RUNNING pre-eval: %s" % args.pre_eval) - r.writeline(args.pre_eval) - assert_prompt(r, ['[^\\s()<>]+> '], args.test_timeout) - -test_cnt = 0 -pass_cnt = 0 -fail_cnt = 0 -soft_fail_cnt = 0 -failures = [] - -class TestTimeout(Exception): - pass - -def has_any_match(expects, res): - success = False - for expect in expects: - success = re.search(expect, res, re.S) - if success: - break - return success - -while t.next(): - if args.deferrable == False and t.deferrable: - log(t.deferrable) - break - - if args.optional == False and t.optional: - log(t.optional) - break - - if t.msg != None: - log(t.msg) - continue - - if t.form == None: continue - - log("TEST: %s -> [%s,%s]" % (repr(t.form), repr(t.out), t.ret), end='') - - # The repeated form is to get around an occasional OS X issue - # where the form is repeated. - # https://github.com/kanaka/mal/issues/30 - expects = ["%s%s" % (t.out, re.escape(t.ret)), # for Windows, WSL - ".*%s%s%s" % (sep, t.out, re.escape(t.ret)), # for Linux, OS X - ".*%s.*%s%s%s" % (sep, sep, t.out, re.escape(t.ret))] # for OS X - - r.writeline(t.form) - try: - test_cnt += 1 - # Search with prepending prefix '\n' for avoiding hangs on Windows - res = r.read_to_prompt(['\r\n[^\s()<>]+> ', '\n[^\s()<>]+> '], - timeout=args.test_timeout, search_prefix='\n') - #print "%s,%s,%s" % (idx, repr(p.before), repr(p.after)) - if (res == None): - log(" -> TIMEOUT (line %d)" % t.line_num) - raise TestTimeout("TIMEOUT (line %d)" % t.line_num) - elif (t.ret == "" and t.out == ""): - log(" -> SUCCESS (result ignored)") - pass_cnt += 1 - elif has_any_match(expects, res): - log(" -> SUCCESS") - pass_cnt += 1 - else: - if t.soft and not args.hard: - log(" -> SOFT FAIL (line %d):" % t.line_num) - soft_fail_cnt += 1 - fail_type = "SOFT " - else: - log(" -> FAIL (line %d):" % t.line_num) - fail_cnt += 1 - fail_type = "" - log(" Expected : %s" % repr(expects[0])) - log(" Got : %s" % repr(res)) - failed_test = """%sFAILED TEST (line %d): %s -> [%s,%s]: - Expected : %s - Got : %s""" % (fail_type, t.line_num, t.form, repr(t.out), - t.ret, repr(expects[0]), repr(res)) - failures.append(failed_test) - except: - _, exc, _ = sys.exc_info() - log("\nException: %s" % repr(exc)) - log("Output before exception:\n%s" % r.buf) - sys.exit(1) - -if len(failures) > 0: - log("\nFAILURES:") - for f in failures: - log(f) - -results = """ -TEST RESULTS (for %s): - %3d: soft failing tests - %3d: failing tests - %3d: passing tests - %3d: total tests -""" % (args.test_file, soft_fail_cnt, fail_cnt, - pass_cnt, test_cnt) -log(results) - -debug("\n") # add some separate to debug log - -if fail_cnt > 0: - sys.exit(1) -sys.exit(0) From 712cf5e811b5fe8cb86fc7d8362c80c582096e9a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sat, 10 Aug 2024 13:22:59 +0800 Subject: [PATCH 108/129] vbs: uncomment impls for `Action` test --- IMPLS.yml | 242 +++++++++++++++++++++++++++--------------------------- 1 file changed, 121 insertions(+), 121 deletions(-) diff --git a/IMPLS.yml b/IMPLS.yml index 3c17dce5a5..02a8056ce8 100644 --- a/IMPLS.yml +++ b/IMPLS.yml @@ -1,125 +1,125 @@ IMPL: -# - {IMPL: ada} -# - {IMPL: ada.2} -# - {IMPL: awk} -# - {IMPL: bash, NO_SELF_HOST: 1} # step8 timeout -# - {IMPL: basic, basic_MODE: cbm, NO_SELF_HOST: 1} # step4 OOM -# - {IMPL: basic, basic_MODE: qbasic, NO_SELF_HOST: 1} # step4 OOM -# - {IMPL: bbc-basic} -# - {IMPL: c} -# - {IMPL: c.2} -# - {IMPL: cpp} -# - {IMPL: coffee} -# - {IMPL: cs} -# - {IMPL: chuck, NO_SELF_HOST_PERF: 1} # perf OOM -# - {IMPL: clojure, clojure_MODE: clj} -# - {IMPL: clojure, clojure_MODE: cljs} -# - {IMPL: common-lisp} -# - {IMPL: crystal} -# - {IMPL: d, d_MODE: gdc} -# - {IMPL: d, d_MODE: ldc2} -# - {IMPL: d, d_MODE: dmd} -# - {IMPL: dart} -# - {IMPL: elisp} -# - {IMPL: elixir} -# - {IMPL: elm} -# - {IMPL: erlang, NO_SELF_HOST: 1} # step8 OOM -# - {IMPL: es6} -# - {IMPL: factor} -# - {IMPL: fantom} -# - {IMPL: fennel} -# - {IMPL: forth} -# - {IMPL: fsharp} -# - {IMPL: go} -# - {IMPL: groovy} -# - {IMPL: gnu-smalltalk} -# - {IMPL: guile} -# - {IMPL: haskell} -# - {IMPL: haxe, haxe_MODE: neko} -# - {IMPL: haxe, haxe_MODE: python} -# - {IMPL: haxe, haxe_MODE: cpp, SLOW: 1} -# - {IMPL: haxe, haxe_MODE: js} -# - {IMPL: hy} -# - {IMPL: io, NO_SELF_HOST_PERF: 1} # perf OOM -# - {IMPL: janet} -# - {IMPL: java} -# - {IMPL: java-truffle} -# - {IMPL: jq} -# - {IMPL: js} -# - {IMPL: julia} -# - {IMPL: kotlin} -# - {IMPL: latex3, NO_PERF: 1, NO_SELF_HOST: 1, SLOW: 1} -# - {IMPL: livescript} -# - {IMPL: logo} -# - {IMPL: lua} -# - {IMPL: make, NO_SELF_HOST: 1} # step4 timeout -# - {IMPL: mal, MAL_IMPL: js, BUILD_IMPL: js, NO_SELF_HOST: 1} -# - {IMPL: mal, MAL_IMPL: js-mal, BUILD_IMPL: js, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} -# - {IMPL: mal, MAL_IMPL: nim, BUILD_IMPL: nim, NO_SELF_HOST: 1} -# - {IMPL: mal, MAL_IMPL: nim-mal, BUILD_IMPL: nim, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} -# - {IMPL: matlab, NO_SELF_HOST_PERF: 1} # Octave, perf timeout -# - {IMPL: miniMAL, NO_SELF_HOST_PERF: 1, SLOW: 1} # perf timeout -# - {IMPL: nasm, NO_SELF_HOST_PERF: 1} # perf OOM -# - {IMPL: nim} -# - {IMPL: objpascal} -# - {IMPL: objc} -# - {IMPL: ocaml} -# - {IMPL: perl} -# - {IMPL: perl6} -# - {IMPL: php} -# - {IMPL: picolisp} -# - {IMPL: pike} -# - {IMPL: plpgsql, NO_SELF_HOST: 1, SLOW: 1} # step3 timeout -# # - {IMPL: plsql} -# - {IMPL: prolog} -# - {IMPL: ps} -# - {IMPL: powershell, NO_SELF_HOST_PERF: 1} -# - {IMPL: purs} -# - {IMPL: python, python_MODE: python2} -# - {IMPL: python, python_MODE: python3} -# - {IMPL: python.2} -# - {IMPL: r} -# - {IMPL: racket} -# - {IMPL: rexx} -# - {IMPL: rpython, SLOW: 1} -# - {IMPL: ruby} -# - {IMPL: ruby.2} -# - {IMPL: rust} -# - {IMPL: scala} -# - {IMPL: scheme, scheme_MODE: chibi} -# - {IMPL: scheme, scheme_MODE: kawa} -# - {IMPL: scheme, scheme_MODE: gauche} -# - {IMPL: scheme, scheme_MODE: chicken} -# - {IMPL: scheme, scheme_MODE: sagittarius} -# - {IMPL: scheme, scheme_MODE: cyclone} -# # - {IMPL: scheme, scheme_MODE: foment} -# - {IMPL: skew} -# - {IMPL: sml, sml_MODE: polyml} -# - {IMPL: sml, sml_MODE: mlton} -# - {IMPL: sml, sml_MODE: mosml} -# - {IMPL: tcl} -# - {IMPL: ts} -# - {IMPL: vala} -# - {IMPL: vb} -# - {IMPL: vhdl, NO_SELF_HOST_PERF: 1} # perf timeout -# - {IMPL: vimscript} -# # no self-host perf for wasm due to mac stack overflow -# - {IMPL: wasm, wasm_MODE: wasmtime, NO_SELF_HOST_PERF: 1, NO_PERF: 1} -# - {IMPL: wasm, wasm_MODE: wasmer, NO_SELF_HOST_PERF: 1, NO_PERF: 1} -# #- {IMPL: wasm, wasm_MODE: wax, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions -# - {IMPL: wasm, wasm_MODE: node, NO_SELF_HOST_PERF: 1, NO_PERF: 1} -# #- {IMPL: wasm, wasm_MODE: warpy, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions -# #- {IMPL: wasm, wasm_MODE: wace_libc, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions -# - {IMPL: wren} -# - {IMPL: xslt} -# - {IMPL: yorick} -# - {IMPL: zig} + - {IMPL: ada} + - {IMPL: ada.2} + - {IMPL: awk} + - {IMPL: bash, NO_SELF_HOST: 1} # step8 timeout + - {IMPL: basic, basic_MODE: cbm, NO_SELF_HOST: 1} # step4 OOM + - {IMPL: basic, basic_MODE: qbasic, NO_SELF_HOST: 1} # step4 OOM + - {IMPL: bbc-basic} + - {IMPL: c} + - {IMPL: c.2} + - {IMPL: cpp} + - {IMPL: coffee} + - {IMPL: cs} + - {IMPL: chuck, NO_SELF_HOST_PERF: 1} # perf OOM + - {IMPL: clojure, clojure_MODE: clj} + - {IMPL: clojure, clojure_MODE: cljs} + - {IMPL: common-lisp} + - {IMPL: crystal} + - {IMPL: d, d_MODE: gdc} + - {IMPL: d, d_MODE: ldc2} + - {IMPL: d, d_MODE: dmd} + - {IMPL: dart} + - {IMPL: elisp} + - {IMPL: elixir} + - {IMPL: elm} + - {IMPL: erlang, NO_SELF_HOST: 1} # step8 OOM + - {IMPL: es6} + - {IMPL: factor} + - {IMPL: fantom} + - {IMPL: fennel} + - {IMPL: forth} + - {IMPL: fsharp} + - {IMPL: go} + - {IMPL: groovy} + - {IMPL: gnu-smalltalk} + - {IMPL: guile} + - {IMPL: haskell} + - {IMPL: haxe, haxe_MODE: neko} + - {IMPL: haxe, haxe_MODE: python} + - {IMPL: haxe, haxe_MODE: cpp, SLOW: 1} + - {IMPL: haxe, haxe_MODE: js} + - {IMPL: hy} + - {IMPL: io, NO_SELF_HOST_PERF: 1} # perf OOM + - {IMPL: janet} + - {IMPL: java} + - {IMPL: java-truffle} + - {IMPL: jq} + - {IMPL: js} + - {IMPL: julia} + - {IMPL: kotlin} + - {IMPL: latex3, NO_PERF: 1, NO_SELF_HOST: 1, SLOW: 1} + - {IMPL: livescript} + - {IMPL: logo} + - {IMPL: lua} + - {IMPL: make, NO_SELF_HOST: 1} # step4 timeout + - {IMPL: mal, MAL_IMPL: js, BUILD_IMPL: js, NO_SELF_HOST: 1} + - {IMPL: mal, MAL_IMPL: js-mal, BUILD_IMPL: js, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} + - {IMPL: mal, MAL_IMPL: nim, BUILD_IMPL: nim, NO_SELF_HOST: 1} + - {IMPL: mal, MAL_IMPL: nim-mal, BUILD_IMPL: nim, NO_SELF_HOST: 1, NO_PERF: 1, SLOW: 1} + - {IMPL: matlab, NO_SELF_HOST_PERF: 1} # Octave, perf timeout + - {IMPL: miniMAL, NO_SELF_HOST_PERF: 1, SLOW: 1} # perf timeout + - {IMPL: nasm, NO_SELF_HOST_PERF: 1} # perf OOM + - {IMPL: nim} + - {IMPL: objpascal} + - {IMPL: objc} + - {IMPL: ocaml} + - {IMPL: perl} + - {IMPL: perl6} + - {IMPL: php} + - {IMPL: picolisp} + - {IMPL: pike} + - {IMPL: plpgsql, NO_SELF_HOST: 1, SLOW: 1} # step3 timeout +# - {IMPL: plsql} + - {IMPL: prolog} + - {IMPL: ps} + - {IMPL: powershell, NO_SELF_HOST_PERF: 1} + - {IMPL: purs} + - {IMPL: python, python_MODE: python2} + - {IMPL: python, python_MODE: python3} + - {IMPL: python.2} + - {IMPL: r} + - {IMPL: racket} + - {IMPL: rexx} + - {IMPL: rpython, SLOW: 1} + - {IMPL: ruby} + - {IMPL: ruby.2} + - {IMPL: rust} + - {IMPL: scala} + - {IMPL: scheme, scheme_MODE: chibi} + - {IMPL: scheme, scheme_MODE: kawa} + - {IMPL: scheme, scheme_MODE: gauche} + - {IMPL: scheme, scheme_MODE: chicken} + - {IMPL: scheme, scheme_MODE: sagittarius} + - {IMPL: scheme, scheme_MODE: cyclone} +# - {IMPL: scheme, scheme_MODE: foment} + - {IMPL: skew} + - {IMPL: sml, sml_MODE: polyml} + - {IMPL: sml, sml_MODE: mlton} + - {IMPL: sml, sml_MODE: mosml} + - {IMPL: tcl} + - {IMPL: ts} + - {IMPL: vala} + - {IMPL: vb} + - {IMPL: vhdl, NO_SELF_HOST_PERF: 1} # perf timeout + - {IMPL: vimscript} + # no self-host perf for wasm due to mac stack overflow + - {IMPL: wasm, wasm_MODE: wasmtime, NO_SELF_HOST_PERF: 1, NO_PERF: 1} + - {IMPL: wasm, wasm_MODE: wasmer, NO_SELF_HOST_PERF: 1, NO_PERF: 1} + #- {IMPL: wasm, wasm_MODE: wax, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions + - {IMPL: wasm, wasm_MODE: node, NO_SELF_HOST_PERF: 1, NO_PERF: 1} + #- {IMPL: wasm, wasm_MODE: warpy, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions + #- {IMPL: wasm, wasm_MODE: wace_libc, NO_SELF_HOST_PERF: 1} # Hangs on GH Actions + - {IMPL: wren} + - {IMPL: xslt} + - {IMPL: yorick} + - {IMPL: zig} -# # See .travis.yml (for older osx / xcode tests) -# # - {IMPL: objc, NO_DOCKER: 1, OS: xcode7}} -# # - {IMPL: swift, NO_DOCKER: 1, OS: xcode7.3}} -# # - {IMPL: swift3, NO_DOCKER: 1, OS: xcode8}} -# # - {IMPL: swift4, NO_DOCKER: 1, OS: xcode10}} -# - {IMPL: swift5, NO_DOCKER: 1, OS: macos} + # See .travis.yml (for older osx / xcode tests) +# - {IMPL: objc, NO_DOCKER: 1, OS: xcode7}} +# - {IMPL: swift, NO_DOCKER: 1, OS: xcode7.3}} +# - {IMPL: swift3, NO_DOCKER: 1, OS: xcode8}} +# - {IMPL: swift4, NO_DOCKER: 1, OS: xcode10}} + - {IMPL: swift5, NO_DOCKER: 1, OS: macos} - {IMPL: vbs, NO_DOCKER: 1, OS: windows} From 2109872b2d3286ecf52819fd39bfc98308b8f130 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Sun, 11 Aug 2024 07:17:21 +0800 Subject: [PATCH 109/129] vbs: Merge branch 'kanaka:master' into master --- process/guide.md | 68 ++++++++++++++++++++++++------------------------ 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/process/guide.md b/process/guide.md index 5e528a7d32..ce549884b1 100644 --- a/process/guide.md +++ b/process/guide.md @@ -310,7 +310,7 @@ expression support. * Add a `reader.qx` file to hold functions related to the reader. -* If the target language has objects types (OOP), then the next step +* If the target language has object types (OOP), then the next step is to create a simple stateful Reader object in `reader.qx`. This object will store the tokens and a position. The Reader object will have two methods: `next` and `peek`. `next` returns the token at @@ -368,7 +368,7 @@ expression support. * Add the function `read_list` to `reader.qx`. This function will repeatedly call `read_form` with the Reader object until it - encounters a ')' token (if it reach EOF before reading a ')' then + encounters a ')' token (if it reaches EOF before reading a ')' then that is an error). It accumulates the results into a List type. If your language does not have a sequential data type that can hold mal type values you may need to implement one (in `types.qx`). Note @@ -384,7 +384,7 @@ expression support. the other fundamental mal types: nil, true, false, and string. The remaining scalar mal type, keyword does not need to be implemented until step A (but can be implemented at any - point between this step and that). BTW, symbols types are just an + point between this step and that). BTW, symbol types are just an object that contains a single string name value (some languages have symbol types already). @@ -522,7 +522,7 @@ functionality to the evaluator (`EVAL`). Compare the pseudocode for step 1 and step 2 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step1_read_print.txt ../process/step2_eval.txt +diff -u ../process/step1_read_print.txt ../process/step2_eval.txt ``` * Copy `step1_read_print.qx` to `step2_eval.qx`. @@ -568,7 +568,7 @@ Try some simple expressions: * `(+ 2 (* 3 4))` -> `14` The most likely challenge you will encounter is how to properly call -a function references using an arguments list. +a function reference using an arguments list. Now go to the top level, run the step 2 tests and fix the errors. ``` @@ -623,7 +623,7 @@ chain). Compare the pseudocode for step 2 and step 3 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step2_eval.txt ../process/step3_env.txt +diff -u ../process/step2_eval.txt ../process/step3_env.txt ``` * Copy `step2_eval.qx` to `step3_env.qx`. @@ -741,7 +741,7 @@ In some Lisps, this special form is named "lambda". Compare the pseudocode for step 3 and step 4 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step3_env.txt ../process/step4_if_fn_do.txt +diff -u ../process/step3_env.txt ../process/step4_if_fn_do.txt ``` * Copy `step3_env.qx` to `step4_if_fn_do.qx`. @@ -804,7 +804,7 @@ Try out the basic functionality you have implemented: * Add the following functions to `core.ns`: * `prn`: call `pr_str` on the first parameter with `print_readably` - set to true, prints the result to the screen and then return + set to true, print the result to the screen and then return `nil`. Note that the full version of `prn` is a deferrable below. * `list`: take the parameters and return them as a list. * `list?`: return true if the first parameter is a list, false @@ -848,7 +848,7 @@ from a neat toy to a full featured language. call the `rep` function with this string: "(def! not (fn* (a) (if a false true)))". -* Implement the strings functions in `core.qx`. To implement these +* Implement the string functions in `core.qx`. To implement these functions, you will need to implement the string support in the reader and printer (deferrable section of step 1). Each of the string functions takes multiple mal values, prints them (`pr_str`) and @@ -892,7 +892,7 @@ iteration. Compare the pseudocode for step 4 and step 5 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step4_if_fn_do.txt ../process/step5_tco.txt +diff -u ../process/step4_if_fn_do.txt ../process/step5_tco.txt ``` * Copy `step4_if_fn_do.qx` to `step5_tco.qx`. @@ -939,8 +939,8 @@ diff -urp ../process/step4_if_fn_do.txt ../process/step5_tco.txt before (in step 4). * a `fn*` value: set `ast` to the `ast` attribute of `f`. Generate a new environment using the `env` and `params` attributes of `f` - as the `outer` and `binds` arguments and `args` as the `exprs` - argument. Set `env` to the new environment. Continue at the + as the `outer` and `binds` arguments and `args` as the `exprs` + argument. Set `env` to the new environment. Continue at the beginning of the loop. Run some manual tests from previous steps to make sure you have not @@ -982,7 +982,7 @@ holding off on that you will need to go back and do so. Compare the pseudocode for step 5 and step 6 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step5_tco.txt ../process/step6_file.txt +diff -u ../process/step5_tco.txt ../process/step6_file.txt ``` * Copy `step5_tco.qx` to `step6_file.qx`. @@ -1056,7 +1056,7 @@ You'll need to add 5 functions to the core namespace to support atoms: Optionally, you can add a reader macro `@` which will serve as a short form for `deref`, so that `@a` is equivalent to `(deref a)`. In order to do that, modify -the conditional in reader `read_form` function and add a case which deals with +the conditional in reader function `read_form` and add a case which deals with the `@` token: if the token is `@` (at sign) then return a new list that contains the symbol `deref` and the result of reading the next form (`read_form`). @@ -1121,7 +1121,7 @@ value that it evaluates to. Likewise with lists. For example, consider the following: * `(prn abc)`: this will lookup the symbol `abc` in the current - evaluation environment and print it. This will result in error if + evaluation environment and print it. This will result in an error if `abc` is not defined. * `(prn (quote abc))`: this will print "abc" (prints the symbol itself). This will work regardless of whether `abc` is defined in @@ -1154,7 +1154,7 @@ manifest when it is used together with macros (in the next step). Compare the pseudocode for step 6 and step 7 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step6_file.txt ../process/step7_quote.txt +diff -u ../process/step6_file.txt ../process/step7_quote.txt ``` * Copy `step6_file.qx` to `step7_quote.qx`. @@ -1184,7 +1184,7 @@ Mal borrows most of its syntax and feature-set). following conditional. - If `ast` is a list starting with the "unquote" symbol, return its second element. - - If `ast` is a list failing previous test, the result will be a + - If `ast` is a list failing the previous test, the result will be a list populated by the following process. The result is initially an empty list. @@ -1219,7 +1219,6 @@ Mal borrows most of its syntax and feature-set). as in the previous case if implementation is easier. * Add the `quasiquote` special form. - This form calls the `quasiquote` function using the first `ast` argument (second list element), then evaluates the result in the current environment, @@ -1250,8 +1249,8 @@ macros. short-hand syntaxes are known as reader macros because they allow us to manipulate mal code during the reader phase. Macros that run during the eval phase are just called "macros" and are described in - the next section. Expand the conditional with reader `read_form` - function to add the following four cases: + the next section. Expand the conditional in reader function + `read_form` to add the following four cases: * token is "'" (single quote): return a new list that contains the symbol "quote" and the result of reading the next form (`read_form`). @@ -1299,7 +1298,7 @@ the mal language itself. Compare the pseudocode for step 7 and step 8 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step7_quote.txt ../process/step8_macros.txt +diff -u ../process/step7_quote.txt ../process/step8_macros.txt ``` * Copy `step7_quote.qx` to `step8_macros.qx`. @@ -1348,6 +1347,7 @@ There is a reasonably good chance that the macro tests will not pass the first time. Although the implementation of macros is fairly simple, debugging runtime bugs with macros can be fairly tricky. If you do run into subtle problems that are difficult to solve, let me + recommend an approach: * Enable the debug print statement at the top of your main `eval` @@ -1384,11 +1384,11 @@ implementation. Let us continue! as arguments, returns the element of the list at the given index. If the index is out of range, this function raises an exception. * `first`: this function takes a list (or vector) as its argument - and return the first element. If the list (or vector) is empty or + and returns the first element. If the list (or vector) is empty or is `nil` then `nil` is returned. * `rest`: this function takes a list (or vector) as its argument and returns a new list containing all the elements except the first. If - the list (or vector) is empty or is `nil` then `()` (empty list) + the list (or vector) is empty or is `nil` then `()` (empty list) is returned. * In the main program, call the `rep` function with the following @@ -1417,7 +1417,7 @@ functional programming pedigree of your implementation by adding the Compare the pseudocode for step 8 and step 9 to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step8_macros.txt ../process/step9_try.txt +diff -u ../process/step8_macros.txt ../process/step9_try.txt ``` * Copy `step8_macros.qx` to `step9_try.qx`. @@ -1479,7 +1479,7 @@ diff -urp ../process/step8_macros.txt ../process/step9_try.txt function against every element of the list (or vector) one at a time and returns the results as a list. -* Add some type predicates core functions. In Lisp, predicates are +* Add some type predicate core functions. In Lisp, predicates are functions that return true/false (or true value/nil) and typically end in "?" or "p". * `nil?`: takes a single argument and returns true (mal true value) @@ -1574,7 +1574,7 @@ implementation to self-host. Compare the pseudocode for step 9 and step A to get a basic idea of the changes that will be made during this step: ``` -diff -urp ../process/step9_try.txt ../process/stepA_mal.txt +diff -u ../process/step9_try.txt ../process/stepA_mal.txt ``` * Copy `step9_try.qx` to `stepA_mal.qx`. @@ -1607,7 +1607,7 @@ make "test^quux^stepA" Once you have passed all the non-optional step A tests, it is time to try self-hosting. Run your step A implementation as normal, but use -the file argument mode you added in step 6 to run a each of the step +the file argument mode you added in step 6 to run each step from the mal implementation: ``` ./stepA_mal.qx ../mal/step1_read_print.mal @@ -1661,17 +1661,17 @@ implementation. * `meta`: this takes a single mal function/list/vector/hash-map argument and returns the value of the metadata attribute. * `with-meta`: this function takes two arguments. The first argument - is a mal function/list/vector/hash-map and the second argument is - another mal value/type to set as metadata. A copy of the mal function is - returned that has its `meta` attribute set to the second argument. - Note that it is important that the environment and macro attribute - of mal function are retained when it is copied. + is a mal value and the second argument is another mal value/type + to set as metadata. A copy of the mal value is returned that has + its `meta` attribute set to the second argument. Note that when + copying a mal function, it is important that the environment and + macro attribute are retained. * Add a reader-macro that expands the token "^" to return a new list that contains the symbol "with-meta" and the result of reading the next next form (2nd argument) (`read_form`) and the next form (1st argument) in that order (metadata comes first with the ^ macro and the function second). - * If you implemented as `defmacro!` to mutate an existing function + * If you implemented `defmacro!` as mutating an existing function without copying it, you can now use the function copying mechanism used for metadata to make functions immutable even in the defmacro! case... @@ -1698,7 +1698,7 @@ implementation. * `seq`: takes a list, vector, string, or nil. If an empty list, empty vector, or empty string ("") is passed in then nil is returned. Otherwise, a list is returned unchanged, a vector is - converted into a list, and a string is converted to a list that + converted into a list, and a string is converted to a list containing the original string split into single character strings. * For interop with the target language, add this core function: From 6490e42e8f5be14d0a366429559318815f9366e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 09:43:15 +0800 Subject: [PATCH 110/129] vbs: test `WSH.Echo "\nuser>"` --- impls/vbs/core.vbs | 1 + impls/vbs/step1_read_print.vbs | 4 ++-- impls/vbs/stepA_mal.vbs | 4 ++-- 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index cef8933dda..dc3482b07f 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -711,6 +711,7 @@ Function MReadLine(objArgs, objEnv) CheckType objArgs.Item(1), TYPES.STRING Dim strInput + WScript.Echo "" WScript.StdOut.Write objArgs.Item(1).Value On Error Resume Next strInput = WScript.StdIn.ReadLine() diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index 34e0e55a0f..63ad0cc1ec 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -23,9 +23,9 @@ Sub REPL() 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description WScript.StdOut.WriteLine "Exception: " + Err.Description Else - If strRes <> "" Then + ' If strRes <> "" Then WScript.Echo strRes - End If + ' End If End If On Error Goto 0 Wend diff --git a/impls/vbs/stepA_mal.vbs b/impls/vbs/stepA_mal.vbs index 9992cdb72a..d4a5e8764f 100644 --- a/impls/vbs/stepA_mal.vbs +++ b/impls/vbs/stepA_mal.vbs @@ -414,9 +414,9 @@ Sub REPL() WScript.StdOut.WriteLine "Exception: " + Err.Description End If Else - If strRes <> "" Then + ' If strRes <> "" Then WScript.Echo strRes - End If + ' End If End If On Error Goto 0 Wend From d1aabf07fd508e20af0fdfc81810493acd6ed187 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 10:42:04 +0800 Subject: [PATCH 111/129] vbs: import variable `MAL_VBS_IMPL_NO_STDERR` & `MAL_VBS_IMPL_ECHO_STDIN` --- impls/vbs/run | 2 ++ 1 file changed, 2 insertions(+) diff --git a/impls/vbs/run b/impls/vbs/run index 63de716ee0..93cc7dafe7 100644 --- a/impls/vbs/run +++ b/impls/vbs/run @@ -1,2 +1,4 @@ #!/bin/bash +MAL_VBS_IMPL_NO_STDERR=1 MAL_VBS_IMPL_ECHO_STDIN=1 \ +WSLENV=MAL_VBS_IMPL_NO_STDERR/w:MAL_VBS_IMPL_ECHO_STDIN/w \ cscript.exe -nologo $(dirname $0)/${STEP:-stepA_mal}.vbs "${@}" From d1795ee74bff27f5e30496845b750ccbf30cb457 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 10:51:34 +0800 Subject: [PATCH 112/129] vbs: impl `IOWrap` class in `io.vbs` --- impls/vbs/io.vbs | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 impls/vbs/io.vbs diff --git a/impls/vbs/io.vbs b/impls/vbs/io.vbs new file mode 100644 index 0000000000..cf5470d779 --- /dev/null +++ b/impls/vbs/io.vbs @@ -0,0 +1,44 @@ +Class IOWrap + Public NoStdErr + Public EchoStdIn + + Private Sub Class_Initialize + With WScript.CreateObject("WScript.Shell") + NoStdErr = CBool(.ExpandEnvironmentStrings("%MAL_VBS_IMPL_NO_STDERR%")) + EchoStdIn = CBool(.ExpandEnvironmentStrings("%MAL_VBS_IMPL_ECHO_STDIN%")) + End With + End Sub + + Public Sub Write(sText) + WScript.StdOut.Write sText + End Sub + + Public Sub WriteLine(sText) + WScript.StdOut.WriteLine sText + End Sub + + Public Function ReadLine() + ReadLine = WScript.StdIn.ReadLine + If EchoStdIn Then + WScript.StdOut.WriteLine ReadLine + End If + End Function + + Public Sub WriteErr(sText) + If Not NoStdErr Then + WScript.StdErr.Write sText + Else ' Redirect to StdOut + WScript.StdOut.Write sText + End If + End Sub + + Public Sub WriteErrLine(sText) + If Not NoStdErr Then + WScript.StdErr.WriteLine sText + Else ' Redirect to StdOut + WScript.StdOut.WriteLine sText + End If + End Sub +End Class + +Set IO = New IOWrap \ No newline at end of file From e4acbfd4d306893ea6ff147fea460a6f16d812b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 10:55:58 +0800 Subject: [PATCH 113/129] vbs: Restore `runtest.py` --- runtest.py | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/runtest.py b/runtest.py index 6e2f5d088a..2f8ebca08f 100755 --- a/runtest.py +++ b/runtest.py @@ -284,15 +284,11 @@ class TestTimeout(Exception): log("TEST: %s -> [%s,%s]" % (repr(t.form), repr(t.out), t.ret), end='') - if args.no_pty: - # Do not assume the input forms (and newline) are echo'd to stdout - expects = ["%s%s" % (t.out, re.escape(t.ret))] - else: - # The repeated form is to get around an occasional OS X issue - # where the form is repeated. - # https://github.com/kanaka/mal/issues/30 - expects = [".*%s%s%s" % (sep, t.out, re.escape(t.ret)), - ".*%s.*%s%s%s" % (sep, sep, t.out, re.escape(t.ret))] + # The repeated form is to get around an occasional OS X issue + # where the form is repeated. + # https://github.com/kanaka/mal/issues/30 + expects = [".*%s%s%s" % (sep, t.out, re.escape(t.ret)), + ".*%s.*%s%s%s" % (sep, sep, t.out, re.escape(t.ret))] r.writeline(t.form) try: @@ -306,7 +302,8 @@ class TestTimeout(Exception): elif (t.ret == "" and t.out == ""): log(" -> SUCCESS (result ignored)") pass_cnt += 1 - elif next((e for e in expects if re.search(e, res, re.S)), False): + elif (re.search(expects[0], res, re.S) or + re.search(expects[1], res, re.S)): log(" -> SUCCESS") pass_cnt += 1 else: From b96608c45b893b8afa2fd5f5cf6d09f60e6eb177 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 10:58:41 +0800 Subject: [PATCH 114/129] vbs: rewrite step0 use `IOWrap` for test --- impls/vbs/step0_repl.vbs | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/impls/vbs/step0_repl.vbs b/impls/vbs/step0_repl.vbs index 9c920dab44..d3ef939852 100644 --- a/impls/vbs/step0_repl.vbs +++ b/impls/vbs/step0_repl.vbs @@ -1,5 +1,7 @@ Option Explicit +Include "IO.vbs" + Function Read(strCode) Read = strCode End Function @@ -20,9 +22,19 @@ Dim strCode While True 'REPL WScript.StdOut.Write "user> " On Error Resume Next - strCode = WScript.StdIn.ReadLine() + strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 - WScript.Echo REP(strCode) + IO.WriteLine REP(strCode) Wend + + +Sub Include(strFileName) + With CreateObject("Scripting.FileSystemObject") + ExecuteGlobal .OpenTextFile( _ + .GetParentFolderName( _ + .GetFile(WScript.ScriptFullName)) & _ + "\" & strFileName).ReadAll + End With +End Sub \ No newline at end of file From eb030254aef93234b441924a7dd5dc18b294b105 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 11:02:43 +0800 Subject: [PATCH 115/129] vbs: rewrite step1's IO with `IOWrap` --- impls/vbs/step1_read_print.vbs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index 63ad0cc1ec..459ea95d41 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -1,5 +1,6 @@ Option Explicit +Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" @@ -9,10 +10,10 @@ Call REPL() Sub REPL() Dim strCode While True - WScript.StdOut.Write "user> " + IO.Write "user> " On Error Resume Next - strCode = WScript.StdIn.ReadLine() + strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 @@ -20,12 +21,11 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description - WScript.StdOut.WriteLine "Exception: " + Err.Description + IO.WriteErrLine "Exception: " + Err.Description Else - ' If strRes <> "" Then - WScript.Echo strRes - ' End If + If strRes <> "" Then + IO.WriteLine strRes + End If End If On Error Goto 0 Wend From 95d617e15225b1ec24684aa11aed9c18a860ab9d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 11:10:48 +0800 Subject: [PATCH 116/129] vbs: Update `io.vbs` for avoid error --- impls/vbs/io.vbs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/impls/vbs/io.vbs b/impls/vbs/io.vbs index cf5470d779..06f606ea35 100644 --- a/impls/vbs/io.vbs +++ b/impls/vbs/io.vbs @@ -4,8 +4,8 @@ Class IOWrap Private Sub Class_Initialize With WScript.CreateObject("WScript.Shell") - NoStdErr = CBool(.ExpandEnvironmentStrings("%MAL_VBS_IMPL_NO_STDERR%")) - EchoStdIn = CBool(.ExpandEnvironmentStrings("%MAL_VBS_IMPL_ECHO_STDIN%")) + NoStdErr = .ExpandEnvironmentStrings("%MAL_VBS_IMPL_NO_STDERR%") <> "%MAL_VBS_IMPL_NO_STDERR%" + EchoStdIn = .ExpandEnvironmentStrings("%MAL_VBS_IMPL_ECHO_STDIN%") <> "%MAL_VBS_IMPL_ECHO_STDIN%" End With End Sub From e612433edf0b1ae00619eb09e02c576bee876edf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 11:11:05 +0800 Subject: [PATCH 117/129] vbs: rewrite step2 use `IOWrap` --- impls/vbs/step2_eval.vbs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/impls/vbs/step2_eval.vbs b/impls/vbs/step2_eval.vbs index 43c8c2c514..13f4678fe0 100644 --- a/impls/vbs/step2_eval.vbs +++ b/impls/vbs/step2_eval.vbs @@ -1,5 +1,6 @@ Option Explicit +Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" @@ -90,12 +91,12 @@ End Sub Call REPL() Sub REPL() - Dim strCode, strResult + Dim strCode While True - WScript.StdOut.Write "user> " + IO.Write "user> " On Error Resume Next - strCode = WScript.StdIn.ReadLine() + strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 @@ -103,11 +104,10 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description - WScript.StdOut.WriteLine "Exception: " + Err.Description + IO.WriteErrLine "Exception: " + Err.Description Else If strRes <> "" Then - WScript.Echo strRes + IO.WriteLine strRes End If End If On Error Goto 0 From aaa4815a5bc5ffa4c54e708781237ed079046f45 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 11:12:53 +0800 Subject: [PATCH 118/129] vbs: rewrite step3 using `IOWrap` --- impls/vbs/step1_read_print.vbs | 1 - impls/vbs/step3_env.vbs | 10 +++++----- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/impls/vbs/step1_read_print.vbs b/impls/vbs/step1_read_print.vbs index 459ea95d41..014bc40767 100644 --- a/impls/vbs/step1_read_print.vbs +++ b/impls/vbs/step1_read_print.vbs @@ -6,7 +6,6 @@ Include "Reader.vbs" Include "Printer.vbs" Call REPL() - Sub REPL() Dim strCode While True diff --git a/impls/vbs/step3_env.vbs b/impls/vbs/step3_env.vbs index ebc5759bd3..fbedef0cd2 100644 --- a/impls/vbs/step3_env.vbs +++ b/impls/vbs/step3_env.vbs @@ -1,5 +1,6 @@ Option Explicit +Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" @@ -103,10 +104,10 @@ Call REPL() Sub REPL() Dim strCode, strResult While True - WScript.StdOut.Write "user> " + IO.Write "user> " On Error Resume Next - strCode = WScript.StdIn.ReadLine() + strCode = IO.ReadLine() If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 @@ -114,11 +115,10 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description - WScript.StdOut.WriteLine "Exception: " + Err.Description + IO.WriteErrLine "Exception: " + Err.Description Else If strRes <> "" Then - WScript.Echo strRes + IO.WriteLine strRes End If End If On Error Goto 0 From 1b782ac8c20861fc8e56686446aae5d7fb4dfa8c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 11:14:57 +0800 Subject: [PATCH 119/129] vbs: rewrite step4 using `IOWrap` --- impls/vbs/step4_if_fn_do.vbs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/impls/vbs/step4_if_fn_do.vbs b/impls/vbs/step4_if_fn_do.vbs index 896f88a895..38fe48ac5f 100644 --- a/impls/vbs/step4_if_fn_do.vbs +++ b/impls/vbs/step4_if_fn_do.vbs @@ -1,5 +1,6 @@ Option Explicit +Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" @@ -117,10 +118,10 @@ Call REPL() Sub REPL() Dim strCode, strResult While True - WScript.StdOut.Write "user> " + IO.Write "user> " On Error Resume Next - strCode = WScript.StdIn.ReadLine() + strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 @@ -128,11 +129,10 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description - WScript.StdOut.WriteLine "Exception: " + Err.Description + IO.WriteErrLine "Exception: " + Err.Description Else If strRes <> "" Then - WScript.Echo strRes + IO.WriteLine strRes End If End If On Error Goto 0 From 213110582390e411d408a87ae7645407848e7efb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 11:17:25 +0800 Subject: [PATCH 120/129] vbs: rewrite step5 using `IOWrap` --- impls/vbs/step5_tco.vbs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/impls/vbs/step5_tco.vbs b/impls/vbs/step5_tco.vbs index 06b0baa797..ffca17b0a2 100644 --- a/impls/vbs/step5_tco.vbs +++ b/impls/vbs/step5_tco.vbs @@ -1,5 +1,6 @@ Option Explicit +Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" @@ -126,10 +127,10 @@ Call REPL() Sub REPL() Dim strCode, strResult While True - WScript.StdOut.Write "user> " + IO.Write "user> " On Error Resume Next - strCode = WScript.StdIn.ReadLine() + strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 @@ -137,11 +138,10 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description - WScript.StdOut.WriteLine "Exception: " + Err.Description + IO.WriteErrLine "Exception: " + Err.Description Else If strRes <> "" Then - WScript.Echo strRes + IO.WriteLine strRes End If End If On Error Goto 0 From 3ab0917f503cfbb464dd176a6cd02cef369d8039 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 11:19:02 +0800 Subject: [PATCH 121/129] vbs: rewrite step6 using `IOWrap` --- impls/vbs/step6_file.vbs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/impls/vbs/step6_file.vbs b/impls/vbs/step6_file.vbs index 9096f1c132..e29ff303ca 100644 --- a/impls/vbs/step6_file.vbs +++ b/impls/vbs/step6_file.vbs @@ -1,5 +1,6 @@ Option Explicit +Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" @@ -152,12 +153,12 @@ End Sub Call REPL() Sub REPL() - Dim strCode, strResult + Dim strCode While True - WScript.StdOut.Write "user> " + IO.Write "user> " On Error Resume Next - strCode = WScript.StdIn.ReadLine() + strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 @@ -165,11 +166,10 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description - WScript.StdOut.WriteLine "Exception: " + Err.Description + IO.WriteErrLine "Exception: " + Err.Description Else If strRes <> "" Then - WScript.Echo strRes + IO.WriteLine strRes End If End If On Error Goto 0 From cd057cb0b0e3630a157df464d32039ab20807804 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 11:22:02 +0800 Subject: [PATCH 122/129] vbs: rewrite step7 using `IOWrap` --- impls/vbs/step7_quote.vbs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/impls/vbs/step7_quote.vbs b/impls/vbs/step7_quote.vbs index c060962092..304c554ff2 100644 --- a/impls/vbs/step7_quote.vbs +++ b/impls/vbs/step7_quote.vbs @@ -1,5 +1,6 @@ Option Explicit +Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" @@ -278,10 +279,10 @@ Call REPL() Sub REPL() Dim strCode, strResult While True - WScript.StdOut.Write "user> " + IO.Write "user> " On Error Resume Next - strCode = WScript.StdIn.ReadLine() + strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 @@ -289,11 +290,10 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description - WScript.StdOut.WriteLine "Exception: " + Err.Description + IO.WriteErrLine "Exception: " + Err.Description Else If strRes <> "" Then - WScript.Echo strRes + IO.WriteLine strRes End If End If On Error Goto 0 From 76d4b87403bf4ceb8d1dde3e329b408cbf463457 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 11:25:09 +0800 Subject: [PATCH 123/129] vbs: rewrite step8 using `IOWrap` --- impls/vbs/step5_tco.vbs | 2 +- impls/vbs/step7_quote.vbs | 2 +- impls/vbs/step8_macros.vbs | 12 ++++++------ 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/impls/vbs/step5_tco.vbs b/impls/vbs/step5_tco.vbs index ffca17b0a2..c2ea4e4a67 100644 --- a/impls/vbs/step5_tco.vbs +++ b/impls/vbs/step5_tco.vbs @@ -125,7 +125,7 @@ Call InitBuiltIn() Call REPL() Sub REPL() - Dim strCode, strResult + Dim strCode While True IO.Write "user> " diff --git a/impls/vbs/step7_quote.vbs b/impls/vbs/step7_quote.vbs index 304c554ff2..9d2dce7e40 100644 --- a/impls/vbs/step7_quote.vbs +++ b/impls/vbs/step7_quote.vbs @@ -277,7 +277,7 @@ End Sub Call REPL() Sub REPL() - Dim strCode, strResult + Dim strCode While True IO.Write "user> " diff --git a/impls/vbs/step8_macros.vbs b/impls/vbs/step8_macros.vbs index 3b2ab6befd..2c05523c1a 100644 --- a/impls/vbs/step8_macros.vbs +++ b/impls/vbs/step8_macros.vbs @@ -1,5 +1,6 @@ Option Explicit +Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" @@ -330,12 +331,12 @@ End Sub Call REPL() Sub REPL() - Dim strCode, strResult + Dim strCode While True - WScript.StdOut.Write "user> " + IO.Write "user> " On Error Resume Next - strCode = WScript.StdIn.ReadLine() + strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 @@ -343,11 +344,10 @@ Sub REPL() On Error Resume Next strRes = REP(strCode) If Err.Number <> 0 Then - 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description - WScript.StdOut.WriteLine "Exception: " + Err.Description + IO.WriteErrLine "Exception: " + Err.Description Else If strRes <> "" Then - WScript.Echo strRes + IO.WriteLine strRes End If End If On Error Goto 0 From e232ea14df9e30114f4e0f09eb488dfb77df59fb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 11:27:25 +0800 Subject: [PATCH 124/129] vbs: rewrite step9 using `IOWrap` --- impls/vbs/step9_try.vbs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/impls/vbs/step9_try.vbs b/impls/vbs/step9_try.vbs index 75f27104a0..b4c47d6603 100644 --- a/impls/vbs/step9_try.vbs +++ b/impls/vbs/step9_try.vbs @@ -1,5 +1,6 @@ Option Explicit +Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" @@ -390,12 +391,12 @@ End Sub Call REPL() Sub REPL() - Dim strCode, strResult + Dim strCode While True - WScript.StdOut.Write "user> " + IO.Write "user> " On Error Resume Next - strCode = WScript.StdIn.ReadLine() + strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 @@ -404,17 +405,15 @@ Sub REPL() strRes = REP(strCode) If Err.Number <> 0 Then If Err.Source = "MThrow" Then - 'WScript.StdOut.WriteLine Err.Source + ": " + _ - WScript.StdOut.WriteLine "Exception: " + _ + IO.WriteErrLine "Exception: " + _ PrintMalType(objExceptions.Item(Err.Description), True) objExceptions.Remove Err.Description Else - 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description - WScript.StdOut.WriteLine "Exception: " + Err.Description + IO.WriteErrLine "Exception: " + Err.Description End If Else If strRes <> "" Then - WScript.Echo strRes + IO.WriteLine strRes End If End If On Error Goto 0 From bee3fc13b20cfd5690eff5db5b49336aad14ac24 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 11:32:20 +0800 Subject: [PATCH 125/129] vbs: rewrite stepA & core with `IOWrap` --- impls/vbs/core.vbs | 9 ++++----- impls/vbs/stepA_mal.vbs | 19 +++++++++---------- 2 files changed, 13 insertions(+), 15 deletions(-) diff --git a/impls/vbs/core.vbs b/impls/vbs/core.vbs index dc3482b07f..f3302d7a8c 100644 --- a/impls/vbs/core.vbs +++ b/impls/vbs/core.vbs @@ -207,7 +207,7 @@ Function MPrn(objArgs, objEnv) Dim varRet Dim objStr Set objStr = MPrStr(objArgs, objEnv) - WScript.StdOut.WriteLine objStr.Value + IO.WriteLine objStr.Value Set varRet = NewMalNil() Set MPrn = varRet End Function @@ -225,7 +225,7 @@ Function MPrintln(objArgs, objEnv) strRes = strRes + " " + _ PrintMalType(objArgs.Item(i), False) Next - WScript.StdOut.WriteLine strRes + IO.WriteLine strRes Set varRet = NewMalNil() Set MPrintln = varRet End Function @@ -711,10 +711,9 @@ Function MReadLine(objArgs, objEnv) CheckType objArgs.Item(1), TYPES.STRING Dim strInput - WScript.Echo "" - WScript.StdOut.Write objArgs.Item(1).Value + IO.Write objArgs.Item(1).Value On Error Resume Next - strInput = WScript.StdIn.ReadLine() + strInput = IO.ReadLine If Err.Number <> 0 Then Set varRes = NewMalNil() Else diff --git a/impls/vbs/stepA_mal.vbs b/impls/vbs/stepA_mal.vbs index d4a5e8764f..8a53b75013 100644 --- a/impls/vbs/stepA_mal.vbs +++ b/impls/vbs/stepA_mal.vbs @@ -1,5 +1,6 @@ Option Explicit +Include "IO.vbs" Include "Types.vbs" Include "Reader.vbs" Include "Printer.vbs" @@ -390,13 +391,13 @@ End Sub Call REPL() Sub REPL() - Dim strCode, strResult + Dim strCode REP "(println (str ""Mal [""*host-language*""]""))" While True - WScript.StdOut.Write "user> " + IO.Write "user> " On Error Resume Next - strCode = WScript.StdIn.ReadLine() + strCode = IO.ReadLine If Err.Number <> 0 Then WScript.Quit 0 On Error Goto 0 @@ -405,18 +406,16 @@ Sub REPL() strRes = REP(strCode) If Err.Number <> 0 Then If Err.Source = "MThrow" Then - 'WScript.StdOut.WriteLine Err.Source + ": " + _ - WScript.StdOut.WriteLine "Exception: " + _ + IO.WriteErrLine "Exception: " + _ PrintMalType(objExceptions.Item(Err.Description), True) objExceptions.Remove Err.Description Else - 'WScript.StdOut.WriteLine Err.Source + ": " + Err.Description - WScript.StdOut.WriteLine "Exception: " + Err.Description + IO.WriteErrLine "Exception: " + Err.Description End If Else - ' If strRes <> "" Then - WScript.Echo strRes - ' End If + If strRes <> "" Then + IO.WriteLine strRes + End If End If On Error Goto 0 Wend From 5bf003f9be9f2bc134ca02a0be7a254a470dcf3b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 11:44:39 +0800 Subject: [PATCH 126/129] vbs: Merge branch 'kanaka:master' into master --- README.md | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 9642157638..cd8f2c3bf4 100644 --- a/README.md +++ b/README.md @@ -30,9 +30,10 @@ The make-a-lisp steps are: Each make-a-lisp step has an associated architectural diagram. That elements that are new for that step are highlighted in red. -Here is the final diagram for [step A](process/guide.md#stepA): +Here is the final architecture once [step A](process/guide.md#stepA) +is complete: -![stepA_mal architecture](process/stepA_mal.png) +![stepA_mal architecture](process/steps.png) If you are interested in creating a mal implementation (or just interested in using mal for something) you are welcome to to join our @@ -41,7 +42,7 @@ process guide](process/guide.md) there is also a [mal/make-a-lisp FAQ](docs/FAQ.md) where I attempt to answer some common questions. -**3. Mal is implemented in 87 languages (93 different implementations and 114 runtime modes)** +**3. Mal is implemented in 88 languages (94 different implementations and 115 runtime modes)** | Language | Creator | | -------- | ------- | From c3ce0fe2a65b5fc35c46354608a1e3bdbb42c6a9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 23:38:52 +0800 Subject: [PATCH 127/129] vbs: Update 'io.vbs' --- impls/vbs/io.vbs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/impls/vbs/io.vbs b/impls/vbs/io.vbs index 06f606ea35..0df1fafa75 100644 --- a/impls/vbs/io.vbs +++ b/impls/vbs/io.vbs @@ -1,3 +1,5 @@ +Option Explicit + Class IOWrap Public NoStdErr Public EchoStdIn @@ -41,4 +43,5 @@ Class IOWrap End Sub End Class +Dim IO Set IO = New IOWrap \ No newline at end of file From 6176bd71f39a59b346024ca45440cd11904cbcac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Wed, 14 Aug 2024 23:46:54 +0800 Subject: [PATCH 128/129] vbs: Update the implementation counts --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index cd8f2c3bf4..af927451c7 100644 --- a/README.md +++ b/README.md @@ -42,7 +42,7 @@ process guide](process/guide.md) there is also a [mal/make-a-lisp FAQ](docs/FAQ.md) where I attempt to answer some common questions. -**3. Mal is implemented in 88 languages (94 different implementations and 115 runtime modes)** +**3. Mal is implemented in 89 languages (95 different implementations and 116 runtime modes)** | Language | Creator | | -------- | ------- | From 86777be6a4b2c735c1f1315b6af520fe1bba7e46 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E8=80=81=E5=88=98?= <632171029@qq.com> Date: Thu, 15 Aug 2024 09:24:46 +0800 Subject: [PATCH 129/129] vbs: Handle cherry-pick conflicts --- .github/workflows/main.yml | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index bb1074b70a..a982c7c2d6 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -83,7 +83,13 @@ jobs: if: ${{ github.event.inputs.self-hosted == 'yes' }} run: | export ${{ matrix.IMPL }} - DO_SELF_HOST=1 ./ci.sh test ${IMPL} + if [ "${NO_SELF_HOST}" ]; then + echo "Skipping self-host for ${IMPL} due to NO_SELF_HOST variable" + else + DO_SELF_HOST=1 ./ci.sh test ${IMPL} + # Check that self-hosted mode really ran + [ "`grep -a "mal-user>" test-mal-*${IMPL}.debug | wc -l`" -gt 800 ] + fi - name: Archive logs and debug output uses: actions/upload-artifact@v4 with: @@ -121,7 +127,13 @@ jobs: if: ${{ github.event.inputs.self-hosted == 'yes' }} run: | export ${{ matrix.IMPL }} - DO_SELF_HOST=1 ./ci.sh test ${IMPL} + if [ "${NO_SELF_HOST}" ]; then + echo "Skipping self-host for ${IMPL} due to NO_SELF_HOST variable" + else + DO_SELF_HOST=1 ./ci.sh test ${IMPL} + # Check that self-hosted mode really ran + [ "`grep -a "mal-user>" test-mal-*${IMPL}.debug | wc -l`" -gt 800 ] + fi - name: Archive logs and debug output uses: actions/upload-artifact@v4 with: