From fbfe6784d2db983018340e4e1492d8d017029867 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Tue, 21 Jul 2020 18:01:48 +0200 Subject: [PATCH] Change quasiquote algorithm - Add a `vec` built-in function in step7 so that `quasiquote` does not require `apply` from step9. - Introduce quasiquoteexpand special in order to help debugging step7. This may also prepare newcomers to understand step8. - Add soft tests. - Do not quote numbers, strings and so on. Should ideally have been in separate commits: - elisp: simplify and fix (keyword :k) - factor: fix copy/paste error in let*/step7, simplify eval-ast. - guile: improve list/vector types - haskell: revert evaluation during quasiquote - logo, make: cosmetic issues --- docs/exercises.md | 2 +- examples/exercises.mal | 6 +- impls/ada.2/core.adb | 1 + impls/ada.2/step7_quote.adb | 89 ++- impls/ada.2/step8_macros.adb | 89 ++- impls/ada.2/step9_try.adb | 89 ++- impls/ada.2/stepa_mal.adb | 89 ++- impls/ada.2/types-sequences.adb | 8 + impls/ada.2/types-sequences.ads | 1 + impls/ada/core.adb | 23 + impls/ada/step7_quote.adb | 96 ++- impls/ada/step8_macros.adb | 96 ++- impls/ada/step9_try.adb | 96 ++- impls/ada/stepa_mal.adb | 96 ++- impls/awk/core.awk | 19 + impls/awk/step7_quote.awk | 116 ++-- impls/awk/step8_macros.awk | 131 ++-- impls/awk/step9_try.awk | 131 ++-- impls/awk/stepA_mal.awk | 131 ++-- impls/bash/core.sh | 1 + impls/bash/step7_quote.sh | 68 +- impls/bash/step8_macros.sh | 68 +- impls/bash/step9_try.sh | 68 +- impls/bash/stepA_mal.sh | 68 +- impls/bash/types.sh | 6 + impls/basic/core.in.bas | 12 +- impls/basic/step4_if_fn_do.in.bas | 4 +- impls/basic/step5_tco.in.bas | 4 +- impls/basic/step6_file.in.bas | 4 +- impls/basic/step7_quote.in.bas | 126 ++-- impls/basic/step8_macros.in.bas | 126 ++-- impls/basic/step9_try.in.bas | 126 ++-- impls/basic/stepA_mal.in.bas | 126 ++-- impls/bbc-basic/core.bas | 4 + impls/bbc-basic/step7_quote.bas | 40 +- impls/bbc-basic/step8_macros.bas | 40 +- impls/bbc-basic/step9_try.bas | 40 +- impls/bbc-basic/stepA_mal.bas | 40 +- impls/c/core.c | 21 +- impls/c/core.h | 2 +- impls/c/step7_quote.c | 54 +- impls/c/step8_macros.c | 54 +- impls/c/step9_try.c | 54 +- impls/c/stepA_mal.c | 54 +- impls/chuck/core.ck | 3 +- impls/chuck/step7_quote.ck | 74 ++- impls/chuck/step8_macros.ck | 74 ++- impls/chuck/step9_try.ck | 74 ++- impls/chuck/stepA_mal.ck | 74 ++- impls/chuck/types/subr/MalVec.ck | 15 + impls/clojure/src/mal/core.cljc | 1 + impls/clojure/src/mal/step7_quote.cljc | 34 +- impls/clojure/src/mal/step8_macros.cljc | 34 +- impls/clojure/src/mal/step9_try.cljc | 34 +- impls/clojure/src/mal/stepA_mal.cljc | 34 +- impls/coffee/core.coffee | 1 + impls/coffee/step7_quote.coffee | 20 +- impls/coffee/step8_macros.coffee | 20 +- impls/coffee/step9_try.coffee | 20 +- impls/coffee/stepA_mal.coffee | 20 +- impls/common-lisp/src/core.lisp | 3 + impls/common-lisp/src/step7_quote.lisp | 42 +- impls/common-lisp/src/step8_macros.lisp | 43 +- impls/common-lisp/src/step9_try.lisp | 43 +- impls/common-lisp/src/stepA_mal.lisp | 43 +- impls/cpp/Core.cpp | 7 + impls/cpp/step7_quote.cpp | 60 +- impls/cpp/step8_macros.cpp | 65 +- impls/cpp/step9_try.cpp | 65 +- impls/cpp/stepA_mal.cpp | 65 +- impls/crystal/core.cr | 7 + impls/crystal/step7_quote.cr | 63 +- impls/crystal/step8_macros.cr | 63 +- impls/crystal/step9_try.cr | 63 +- impls/crystal/stepA_mal.cr | 63 +- impls/cs/core.cs | 1 + impls/cs/step7_quote.cs | 51 +- impls/cs/step8_macros.cs | 51 +- impls/cs/step9_try.cs | 51 +- impls/cs/stepA_mal.cs | 51 +- impls/d/mal_core.d | 7 + impls/d/step7_quote.d | 43 +- impls/d/step8_macros.d | 43 +- impls/d/step9_try.d | 43 +- impls/d/stepA_mal.d | 43 +- impls/dart/core.dart | 7 + impls/dart/step7_quote.dart | 48 +- impls/dart/step8_macros.dart | 48 +- impls/dart/step9_try.dart | 48 +- impls/dart/stepA_mal.dart | 48 +- impls/elisp/mal/core.el | 106 ++- impls/elisp/mal/printer.el | 35 +- impls/elisp/mal/reader.el | 27 +- impls/elisp/step1_read_print.el | 14 +- impls/elisp/step2_eval.el | 31 +- impls/elisp/step3_env.el | 39 +- impls/elisp/step4_if_fn_do.el | 59 +- impls/elisp/step5_tco.el | 59 +- impls/elisp/step6_file.el | 53 +- impls/elisp/step7_quote.el | 108 ++-- impls/elisp/step8_macros.el | 138 ++-- impls/elisp/step9_try.el | 142 ++-- impls/elisp/stepA_mal.el | 140 ++-- impls/elixir/lib/mal/core.ex | 6 + impls/elixir/lib/mix/tasks/step7_quote.ex | 39 +- impls/elixir/lib/mix/tasks/step8_macros.ex | 39 +- impls/elixir/lib/mix/tasks/step9_try.ex | 39 +- impls/elixir/lib/mix/tasks/stepA_mal.ex | 39 +- impls/elm/Core.elm | 8 + impls/elm/step7_quote.elm | 49 +- impls/elm/step8_macros.elm | 49 +- impls/elm/step9_try.elm | 49 +- impls/elm/stepA_mal.elm | 49 +- impls/erlang/src/core.erl | 6 + impls/erlang/src/step7_quote.erl | 48 +- impls/erlang/src/step8_macros.erl | 48 +- impls/erlang/src/step9_try.erl | 48 +- impls/erlang/src/stepA_mal.erl | 48 +- impls/es6/core.mjs | 1 + impls/es6/step7_quote.mjs | 39 +- impls/es6/step8_macros.mjs | 38 +- impls/es6/step9_try.mjs | 38 +- impls/es6/stepA_mal.mjs | 38 +- impls/factor/lib/core/core.factor | 1 + impls/factor/step2_eval/step2_eval.factor | 20 +- impls/factor/step3_env/step3_env.factor | 12 +- .../step4_if_fn_do/step4_if_fn_do.factor | 12 +- impls/factor/step5_tco/step5_tco.factor | 12 +- impls/factor/step6_file/step6_file.factor | 12 +- impls/factor/step7_quote/step7_quote.factor | 58 +- impls/factor/step8_macros/step8_macros.factor | 56 +- impls/factor/step9_try/step9_try.factor | 56 +- impls/factor/stepA_mal/stepA_mal.factor | 56 +- impls/fantom/src/mallib/fan/core.fan | 1 + impls/fantom/src/step7_quote/fan/main.fan | 45 +- impls/fantom/src/step8_macros/fan/main.fan | 45 +- impls/fantom/src/step9_try/fan/main.fan | 45 +- impls/fantom/src/stepA_mal/fan/main.fan | 45 +- impls/forth/core.fs | 7 + impls/forth/step7_quote.fs | 87 ++- impls/forth/step8_macros.fs | 87 ++- impls/forth/step9_try.fs | 87 ++- impls/forth/stepA_mal.fs | 87 ++- impls/fsharp/core.fs | 6 + impls/fsharp/env.fs | 1 + impls/fsharp/step7_quote.fs | 34 +- impls/fsharp/step8_macros.fs | 34 +- impls/fsharp/step9_try.fs | 34 +- impls/fsharp/stepA_mal.fs | 34 +- impls/gnu-smalltalk/core.st | 2 + impls/gnu-smalltalk/step7_quote.st | 61 +- impls/gnu-smalltalk/step8_macros.st | 61 +- impls/gnu-smalltalk/step9_try.st | 61 +- impls/gnu-smalltalk/stepA_mal.st | 61 +- impls/gnu-smalltalk/types.st | 5 - impls/go/src/core/core.go | 12 + impls/go/src/step7_quote/step7_quote.go | 62 +- impls/go/src/step8_macros/step8_macros.go | 62 +- impls/go/src/step9_try/step9_try.go | 62 +- impls/go/src/stepA_mal/stepA_mal.go | 62 +- impls/groovy/core.groovy | 1 + impls/groovy/step7_quote.groovy | 43 +- impls/groovy/step8_macros.groovy | 43 +- impls/groovy/step9_try.groovy | 43 +- impls/groovy/stepA_mal.groovy | 43 +- impls/guile/core.scm | 3 + impls/guile/step7_quote.scm | 30 +- impls/guile/step8_macros.scm | 30 +- impls/guile/step9_try.scm | 30 +- impls/guile/stepA_mal.scm | 30 +- impls/haskell/Core.hs | 6 + impls/haskell/step7_quote.hs | 36 +- impls/haskell/step8_macros.hs | 36 +- impls/haskell/step9_try.hs | 36 +- impls/haskell/stepA_mal.hs | 36 +- impls/haxe/Step7_quote.hx | 43 +- impls/haxe/Step8_macros.hx | 43 +- impls/haxe/Step9_try.hx | 43 +- impls/haxe/StepA_mal.hx | 43 +- impls/haxe/core/Core.hx | 13 + impls/hy/core.hy | 1 + impls/hy/step7_quote.hy | 33 +- impls/hy/step8_macros.hy | 33 +- impls/hy/step9_try.hy | 33 +- impls/hy/stepA_mal.hy | 33 +- impls/io/MalCore.io | 8 + impls/io/step7_quote.io | 26 +- impls/io/step8_macros.io | 26 +- impls/io/step9_try.io | 26 +- impls/io/stepA_mal.io | 26 +- impls/java/src/main/java/mal/core.java | 7 + impls/java/src/main/java/mal/step7_quote.java | 47 +- .../java/src/main/java/mal/step8_macros.java | 47 +- impls/java/src/main/java/mal/step9_try.java | 47 +- impls/java/src/main/java/mal/stepA_mal.java | 47 +- impls/jq/core.jq | 7 + impls/jq/step7_quote.jq | 56 +- impls/jq/step8_macros.jq | 56 +- impls/jq/step9_try.jq | 56 +- impls/jq/stepA_mal.jq | 56 +- impls/jq/utils.jq | 9 - impls/js/core.js | 10 + impls/js/step7_quote.js | 37 +- impls/js/step8_macros.js | 37 +- impls/js/step9_try.js | 37 +- impls/js/stepA_mal.js | 37 +- impls/julia/core.jl | 1 + impls/julia/step7_quote.jl | 33 +- impls/julia/step8_macros.jl | 33 +- impls/julia/step9_try.jl | 33 +- impls/julia/stepA_mal.jl | 33 +- impls/kotlin/src/mal/core.kt | 5 +- impls/kotlin/src/mal/step7_quote.kt | 59 +- impls/kotlin/src/mal/step8_macros.kt | 59 +- impls/kotlin/src/mal/step9_try.kt | 59 +- impls/kotlin/src/mal/stepA_mal.kt | 59 +- impls/livescript/core.ls | 6 + impls/livescript/step7_quote.ls | 46 +- impls/livescript/step8_macros.ls | 46 +- impls/livescript/step9_try.ls | 46 +- impls/livescript/stepA_mal.ls | 46 +- impls/logo/core.lg | 7 +- impls/logo/step7_quote.lg | 34 +- impls/logo/step8_macros.lg | 34 +- impls/logo/step9_try.lg | 34 +- impls/logo/stepA_mal.lg | 34 +- impls/logo/types.lg | 6 +- impls/lua/core.lua | 5 + impls/lua/step7_quote.lua | 41 +- impls/lua/step8_macros.lua | 41 +- impls/lua/step9_try.lua | 41 +- impls/lua/stepA_mal.lua | 41 +- impls/make/core.mk | 5 +- impls/make/step7_quote.mk | 32 +- impls/make/step8_macros.mk | 31 +- impls/make/step9_try.mk | 31 +- impls/make/stepA_mal.mk | 31 +- impls/make/types.mk | 2 + impls/mal/core.mal | 1 + impls/mal/step2_eval.mal | 2 +- impls/mal/step3_env.mal | 2 +- impls/mal/step4_if_fn_do.mal | 2 +- impls/mal/step6_file.mal | 2 +- impls/mal/step7_quote.mal | 35 +- impls/mal/step8_macros.mal | 35 +- impls/mal/step9_try.mal | 35 +- impls/mal/stepA_mal.mal | 35 +- impls/matlab/core.m | 1 + impls/matlab/step7_quote.m | 49 +- impls/matlab/step8_macros.m | 49 +- impls/matlab/step9_try.m | 49 +- impls/matlab/stepA_mal.m | 49 +- impls/miniMAL/core.json | 1 + impls/miniMAL/step7_quote.json | 44 +- impls/miniMAL/step8_macros.json | 44 +- impls/miniMAL/step9_try.json | 44 +- impls/miniMAL/stepA_mal.json | 44 +- impls/nasm/core.asm | 34 + impls/nasm/step7_quote.asm | 604 ++++++++---------- impls/nasm/step8_macros.asm | 596 ++++++++--------- impls/nasm/step9_try.asm | 596 ++++++++--------- impls/nasm/stepA_mal.asm | 598 ++++++++--------- impls/nim/core.nim | 6 + impls/nim/step7_quote.nim | 36 +- impls/nim/step8_macros.nim | 36 +- impls/nim/step9_try.nim | 36 +- impls/nim/stepA_mal.nim | 36 +- impls/objc/Dockerfile | 2 +- impls/objc/core.m | 3 + impls/objc/step7_quote.m | 54 +- impls/objc/step8_macros.m | 54 +- impls/objc/step9_try.m | 54 +- impls/objc/stepA_mal.m | 54 +- impls/objpascal/core.pas | 5 + impls/objpascal/step7_quote.pas | 60 +- impls/objpascal/step8_macros.pas | 60 +- impls/objpascal/step9_try.pas | 60 +- impls/objpascal/stepA_mal.pas | 60 +- impls/ocaml/Dockerfile | 2 +- impls/ocaml/core.ml | 5 + impls/ocaml/step7_quote.ml | 20 +- impls/ocaml/step8_macros.ml | 20 +- impls/ocaml/step9_try.ml | 22 +- impls/ocaml/stepA_mal.ml | 22 +- impls/perl/core.pm | 1 + impls/perl/step7_quote.pl | 39 +- impls/perl/step8_macros.pl | 39 +- impls/perl/step9_try.pl | 39 +- impls/perl/stepA_mal.pl | 39 +- impls/perl6/core.pm | 1 + impls/perl6/step7_quote.pl | 38 +- impls/perl6/step8_macros.pl | 38 +- impls/perl6/step9_try.pl | 38 +- impls/perl6/stepA_mal.pl | 38 +- impls/php/core.php | 11 + impls/php/step7_quote.php | 36 +- impls/php/step8_macros.php | 39 +- impls/php/step9_try.php | 39 +- impls/php/stepA_mal.php | 39 +- impls/picolisp/core.l | 1 + impls/picolisp/step7_quote.l | 42 +- impls/picolisp/step8_macros.l | 42 +- impls/picolisp/step9_try.l | 42 +- impls/picolisp/stepA_mal.l | 42 +- impls/pike/Core.pmod | 1 + impls/pike/step7_quote.pike | 42 +- impls/pike/step8_macros.pike | 42 +- impls/pike/step9_try.pike | 42 +- impls/pike/stepA_mal.pike | 42 +- impls/plpgsql/core.sql | 10 + impls/plpgsql/step7_quote.sql | 68 +- impls/plpgsql/step8_macros.sql | 68 +- impls/plpgsql/step9_try.sql | 68 +- impls/plpgsql/stepA_mal.sql | 68 +- impls/plsql/core.sql | 16 + impls/plsql/step7_quote.sql | 62 +- impls/plsql/step8_macros.sql | 67 +- impls/plsql/step9_try.sql | 67 +- impls/plsql/stepA_mal.sql | 67 +- impls/powershell/core.psm1 | 9 + impls/powershell/step7_quote.ps1 | 50 +- impls/powershell/step8_macros.ps1 | 50 +- impls/powershell/step9_try.ps1 | 50 +- impls/powershell/stepA_mal.ps1 | 50 +- impls/ps/core.ps | 1 + impls/ps/step7_quote.ps | 57 +- impls/ps/step8_macros.ps | 57 +- impls/ps/step9_try.ps | 57 +- impls/ps/stepA_mal.ps | 57 +- impls/python.2/core.py | 6 + impls/python.2/step7_quote.py | 52 +- impls/python.2/step8_macros.py | 51 +- impls/python.2/step9_try.py | 51 +- impls/python.2/stepA_mal.py | 51 +- impls/python/core.py | 1 + impls/python/step7_quote.py | 35 +- impls/python/step8_macros.py | 35 +- impls/python/step9_try.py | 35 +- impls/python/stepA_mal.py | 35 +- impls/r/core.r | 1 + impls/r/step7_quote.r | 46 +- impls/r/step8_macros.r | 46 +- impls/r/step9_try.r | 46 +- impls/r/stepA_mal.r | 46 +- impls/racket/core.rkt | 1 + impls/racket/step7_quote.rkt | 25 +- impls/racket/step8_macros.rkt | 25 +- impls/racket/step9_try.rkt | 25 +- impls/racket/stepA_mal.rkt | 25 +- impls/rexx/core.rexx | 4 + impls/rexx/step7_quote.rexx | 48 +- impls/rexx/step8_macros.rexx | 48 +- impls/rexx/step9_try.rexx | 48 +- impls/rexx/stepA_mal.rexx | 48 +- impls/rpython/core.py | 8 + impls/rpython/step7_quote.py | 44 +- impls/rpython/step8_macros.py | 43 +- impls/rpython/step9_try.py | 43 +- impls/rpython/stepA_mal.py | 43 +- impls/ruby/core.rb | 1 + impls/ruby/step7_quote.rb | 35 +- impls/ruby/step8_macros.rb | 39 +- impls/ruby/step9_try.rb | 39 +- impls/ruby/stepA_mal.rb | 39 +- impls/rust/core.rs | 8 + impls/rust/step7_quote.rs | 59 +- impls/rust/step8_macros.rs | 59 +- impls/rust/step9_try.rs | 59 +- impls/rust/stepA_mal.rs | 59 +- impls/scala/core.scala | 1 + impls/scala/step7_quote.scala | 51 +- impls/scala/step8_macros.scala | 51 +- impls/scala/step9_try.scala | 51 +- impls/scala/stepA_mal.scala | 51 +- impls/scheme/lib/core.sld | 5 + impls/scheme/step7_quote.scm | 46 +- impls/scheme/step8_macros.scm | 48 +- impls/scheme/step9_try.scm | 48 +- impls/scheme/stepA_mal.scm | 47 +- impls/skew/core.sk | 1 + impls/skew/step7_quote.sk | 43 +- impls/skew/step8_macros.sk | 43 +- impls/skew/step9_try.sk | 43 +- impls/skew/stepA_mal.sk | 43 +- impls/swift/core.swift | 5 + impls/swift/step7_quote.swift | 100 ++- impls/swift/step8_macros.swift | 108 ++-- impls/swift/step9_try.swift | 108 ++-- impls/swift/stepA_mal.swift | 108 ++-- impls/swift3/Sources/core.swift | 8 + impls/swift3/Sources/step7_quote/main.swift | 65 +- impls/swift3/Sources/step8_macros/main.swift | 65 +- impls/swift3/Sources/step9_try/main.swift | 65 +- impls/swift3/Sources/stepA_mal/main.swift | 65 +- impls/swift4/Sources/core.swift | 1 + impls/swift4/Sources/step7_quote/main.swift | 60 +- impls/swift4/Sources/step8_macros/main.swift | 61 +- impls/swift4/Sources/step9_try/main.swift | 61 +- impls/swift4/Sources/stepA_mal/main.swift | 61 +- impls/swift5/Sources/core/Core.swift | 13 + impls/swift5/Sources/step7_quote/main.swift | 73 +-- impls/swift5/Sources/step8_macros/main.swift | 78 +-- impls/swift5/Sources/step9_try/main.swift | 73 +-- impls/swift5/Sources/stepA_mal/main.swift | 73 +-- impls/tcl/core.tcl | 12 + impls/tcl/step7_quote.tcl | 58 +- impls/tcl/step8_macros.tcl | 58 +- impls/tcl/step9_try.tcl | 58 +- impls/tcl/stepA_mal.tcl | 58 +- impls/tests/step7_quote.mal | 191 +++++- impls/tests/step8_macros.mal | 19 + impls/ts/core.ts | 10 + impls/ts/step7_quote.ts | 81 +-- impls/ts/step8_macros.ts | 81 +-- impls/ts/step9_try.ts | 81 +-- impls/ts/stepA_mal.ts | 81 +-- impls/vala/core.vala | 19 + impls/vala/step7_quote.vala | 104 +-- impls/vala/step8_macros.vala | 104 +-- impls/vala/step9_try.vala | 104 +-- impls/vala/stepA_mal.vala | 104 +-- impls/vala/types.vala | 5 - impls/vb/core.vb | 5 + impls/vb/step7_quote.vb | 57 +- impls/vb/step8_macros.vb | 57 +- impls/vb/step9_try.vb | 57 +- impls/vb/stepA_mal.vb | 57 +- impls/vhdl/core.vhdl | 11 + impls/vhdl/step7_quote.vhdl | 101 ++- impls/vhdl/step8_macros.vhdl | 101 ++- impls/vhdl/step9_try.vhdl | 101 ++- impls/vhdl/stepA_mal.vhdl | 101 ++- impls/vimscript/core.vim | 1 + impls/vimscript/step7_quote.vim | 39 +- impls/vimscript/step8_macros.vim | 39 +- impls/vimscript/step9_try.vim | 39 +- impls/vimscript/stepA_mal.vim | 39 +- impls/wasm/core.wam | 5 + impls/wasm/step7_quote.wam | 130 ++-- impls/wasm/step8_macros.wam | 130 ++-- impls/wasm/step9_try.wam | 130 ++-- impls/wasm/stepA_mal.wam | 130 ++-- impls/wren/core.wren | 1 + impls/wren/step7_quote.wren | 36 +- impls/wren/step8_macros.wren | 36 +- impls/wren/step9_try.wren | 36 +- impls/wren/stepA_mal.wren | 36 +- impls/xslt/core.xslt | 10 + impls/xslt/step7_quote.inc.xslt | 138 ++-- impls/xslt/step8_macros.inc.xslt | 139 ++-- impls/xslt/step9_try.inc.xslt | 138 ++-- impls/xslt/stepA_mal.inc.xslt | 138 ++-- impls/yorick/core.i | 11 + impls/yorick/step7_quote.i | 43 +- impls/yorick/step8_macros.i | 43 +- impls/yorick/step9_try.i | 43 +- impls/yorick/stepA_mal.i | 43 +- impls/zig/core.zig | 11 + impls/zig/step7_quote.zig | 90 +-- impls/zig/step8_macros.zig | 90 +-- impls/zig/step9_try.zig | 90 +-- impls/zig/stepA_mal.zig | 90 +-- process/guide.md | 92 ++- process/step7_quote.txt | 2 +- process/step8_macros.txt | 2 +- process/step9_try.txt | 2 +- process/stepA_mal.txt | 2 +- 467 files changed, 13377 insertions(+), 9213 deletions(-) create mode 100644 impls/chuck/types/subr/MalVec.ck diff --git a/docs/exercises.md b/docs/exercises.md index 9a514b8e..6fa78694 100644 --- a/docs/exercises.md +++ b/docs/exercises.md @@ -37,7 +37,7 @@ make REGRESS=1 TEST_OPTS='--hard --pre-eval=\(load-file\ \"../answer.mal\"\)' te - Implement `>`, `<=` and `>=` with `<`. -- Implement `list`, `prn`, `hash-map` and `swap!` as non-recursive +- Implement `list`, `vec`, `prn`, `hash-map` and `swap!` as non-recursive functions. - Implement `count`, `nth`, `map`, `concat` and `conj` with the empty diff --git a/examples/exercises.mal b/examples/exercises.mal index 6f8fba61..babdfc7e 100644 --- a/examples/exercises.mal +++ b/examples/exercises.mal @@ -23,6 +23,7 @@ (def! >= (fn* [a b] (not (< a b)))) (def! list (fn* [& xs] xs)) +(def! vec (fn* [xs] (apply vector xs))) (def! prn (fn* [& xs] (println (apply pr-str xs)))) (def! hash-map (fn* [& xs] (apply assoc {} xs))) (def! swap! (fn* [a f & xs] (reset! a (apply f (deref a) xs)))) @@ -48,7 +49,7 @@ (def! conj (fn* [xs & ys] (if (vector? xs) - (apply vector (concat xs ys)) + (vec (concat xs ys)) (reduce (fn* [acc x] (cons x acc)) xs ys)))) (def! do2 (fn* [& xs] (nth xs (- (count xs) 1)))) @@ -69,8 +70,7 @@ (first (rest ast)) (foldr _quasiquote_iter () ast)) (if (vector? ast) - ;; TODO: once tests are fixed, replace 'list with 'vector. - (list 'apply 'list (foldr _quasiquote_iter () ast)) + (list 'vec (foldr _quasiquote_iter () ast)) (list 'quote ast))))) ;; Interpret kvs as [k1 v1 k2 v2 ... kn vn] and returns diff --git a/impls/ada.2/core.adb b/impls/ada.2/core.adb index 07652aeb..57b5b3cd 100644 --- a/impls/ada.2/core.adb +++ b/impls/ada.2/core.adb @@ -256,6 +256,7 @@ package body Core is P ("throw", Err.Throw'Access); P ("time-ms", Time_Ms'Access); P ("vals", Types.Maps.Vals'Access); + P ("vec", Types.Sequences.Vec'Access); P ("vector", Types.Sequences.Vector'Access); P ("with-meta", With_Meta'Access); end NS_Add_To_Repl; diff --git a/impls/ada.2/step7_quote.adb b/impls/ada.2/step7_quote.adb index d27ad01e..94182fb1 100644 --- a/impls/ada.2/step7_quote.adb +++ b/impls/ada.2/step7_quote.adb @@ -1,5 +1,4 @@ with Ada.Command_Line; -with Ada.Containers.Vectors; with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; @@ -23,7 +22,6 @@ procedure Step7_Quote is use all type Types.Kind_Type; use type Types.Strings.Instance; package ACL renames Ada.Command_Line; - package Vectors is new Ada.Containers.Vectors (Positive, Types.T); function Read return Types.T_Array with Inline; @@ -32,12 +30,7 @@ procedure Step7_Quote is function Eval_Builtin (Args : in Types.T_Array) return Types.T; -- The built-in variant needs to see the Repl variable. - function Quasiquote (Ast : in Types.T; - Env : in Envs.Ptr) return Types.T; - -- Mergeing quote and quasiquote into eval with a flag triggering - -- a different behaviour as done for macros in step8 would improve - -- the performances significantly, but Kanaka finds that it breaks - -- too much the step structure shared by all implementations. + function Quasiquote (Ast : in Types.T) return Types.T; procedure Print (Ast : in Types.T) with Inline; @@ -174,9 +167,13 @@ procedure Step7_Quote is Ast => Ast.Sequence.all.Data (3), Env => Env)); end; + elsif First.Str.all = "quasiquoteexpand" then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + return Quasiquote (Ast.Sequence.all.Data (2)); elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Quasiquote (Ast.Sequence.all.Data (2), Env); + Ast := Quasiquote (Ast.Sequence.all.Data (2)); + goto Restart; else -- Equivalent to First := Eval (First, Env) -- except that we already know enough to spare a recursive call. @@ -266,62 +263,54 @@ procedure Step7_Quote is Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); end Print; - function Quasiquote (Ast : in Types.T; - Env : in Envs.Ptr) return Types.T - is + function Quasiquote (Ast : in Types.T) return Types.T is - function Quasiquote_List (List : in Types.T_Array) return Types.T; - -- Handle vectors and lists not starting with unquote. + function Qq_Seq return Types.T; + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean; - function Quasiquote_List (List : in Types.T_Array) return Types.T is - Vector : Vectors.Vector; -- buffer for concatenation - Tmp : Types.T; + function Qq_Seq return Types.T is + Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil)); begin - for Elt of List loop - if Elt.Kind in Kind_List - and then 0 < Elt.Sequence.all.Length - and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol - and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote" + for Elt of reverse Ast.Sequence.all.Data loop + if Elt.Kind = Kind_List + and then Starts_With (Elt.Sequence.all.Data, "splice-unquote") then Err.Check (Elt.Sequence.all.Length = 2, "splice-unquote expects 1 parameter"); - Tmp := Eval (Elt.Sequence.all.Data (2), Env); - Err.Check (Tmp.Kind = Kind_List, - "splice_unquote expects a list"); - for Sub_Elt of Tmp.Sequence.all.Data loop - Vector.Append (Sub_Elt); - end loop; + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("concat")), + Elt.Sequence.all.Data (2), Result)); else - Vector.Append (Quasiquote (Elt, Env)); + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("cons")), + Quasiquote (Elt), Result)); end if; end loop; - -- Now that we know the number of elements, convert to a list. - declare - Sequence : constant Types.Sequence_Ptr - := Types.Sequences.Constructor (Natural (Vector.Length)); - begin - for I in 1 .. Natural (Vector.Length) loop - Sequence.all.Data (I) := Vector (I); - end loop; - return (Kind_List, Sequence); - end; - end Quasiquote_List; + return Result; + end Qq_Seq; - begin -- Quasiquote + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean is + (0 < Sequence'Length + and then Sequence (Sequence'First).Kind = Kind_Symbol + and then Sequence (Sequence'First).Str.all = Symbol); + + begin case Ast.Kind is - when Kind_Vector => - -- When the test is updated, replace Kind_List with Kind_Vector. - return Quasiquote_List (Ast.Sequence.all.Data); when Kind_List => - if 0 < Ast.Sequence.all.Length - and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol - and then Ast.Sequence.all.Data (1).Str.all = "unquote" - then + if Starts_With (Ast.Sequence.all.Data, "unquote") then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Eval (Ast.Sequence.all.Data (2), Env); + return Ast.Sequence.all.Data (2); else - return Quasiquote_List (Ast.Sequence.all.Data); + return Qq_Seq; end if; + when Kind_Vector => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq)); + when Kind_Map | Kind_Symbol => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast)); when others => return Ast; end case; diff --git a/impls/ada.2/step8_macros.adb b/impls/ada.2/step8_macros.adb index 6233ca4c..1f7951b2 100644 --- a/impls/ada.2/step8_macros.adb +++ b/impls/ada.2/step8_macros.adb @@ -1,5 +1,4 @@ with Ada.Command_Line; -with Ada.Containers.Vectors; with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; @@ -23,7 +22,6 @@ procedure Step8_Macros is use all type Types.Kind_Type; use type Types.Strings.Instance; package ACL renames Ada.Command_Line; - package Vectors is new Ada.Containers.Vectors (Positive, Types.T); function Read return Types.T_Array with Inline; @@ -32,12 +30,7 @@ procedure Step8_Macros is function Eval_Builtin (Args : in Types.T_Array) return Types.T; -- The built-in variant needs to see the Repl variable. - function Quasiquote (Ast : in Types.T; - Env : in Envs.Ptr) return Types.T; - -- Mergeing quote and quasiquote into eval with a flag triggering - -- a different behaviour as done for macros in step8 would improve - -- the performances significantly, but Kanaka finds that it breaks - -- too much the step structure shared by all implementations. + function Quasiquote (Ast : in Types.T) return Types.T; procedure Print (Ast : in Types.T) with Inline; @@ -195,9 +188,13 @@ procedure Step8_Macros is Macroexpanding := True; Ast := Ast.Sequence.all.Data (2); goto Restart; + elsif First.Str.all = "quasiquoteexpand" then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + return Quasiquote (Ast.Sequence.all.Data (2)); elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Quasiquote (Ast.Sequence.all.Data (2), Env); + Ast := Quasiquote (Ast.Sequence.all.Data (2)); + goto Restart; else -- Equivalent to First := Eval (First, Env) -- except that we already know enough to spare a recursive call. @@ -315,62 +312,54 @@ procedure Step8_Macros is Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); end Print; - function Quasiquote (Ast : in Types.T; - Env : in Envs.Ptr) return Types.T - is + function Quasiquote (Ast : in Types.T) return Types.T is - function Quasiquote_List (List : in Types.T_Array) return Types.T; - -- Handle vectors and lists not starting with unquote. + function Qq_Seq return Types.T; + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean; - function Quasiquote_List (List : in Types.T_Array) return Types.T is - Vector : Vectors.Vector; -- buffer for concatenation - Tmp : Types.T; + function Qq_Seq return Types.T is + Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil)); begin - for Elt of List loop - if Elt.Kind in Kind_List - and then 0 < Elt.Sequence.all.Length - and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol - and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote" + for Elt of reverse Ast.Sequence.all.Data loop + if Elt.Kind = Kind_List + and then Starts_With (Elt.Sequence.all.Data, "splice-unquote") then Err.Check (Elt.Sequence.all.Length = 2, "splice-unquote expects 1 parameter"); - Tmp := Eval (Elt.Sequence.all.Data (2), Env); - Err.Check (Tmp.Kind = Kind_List, - "splice_unquote expects a list"); - for Sub_Elt of Tmp.Sequence.all.Data loop - Vector.Append (Sub_Elt); - end loop; + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("concat")), + Elt.Sequence.all.Data (2), Result)); else - Vector.Append (Quasiquote (Elt, Env)); + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("cons")), + Quasiquote (Elt), Result)); end if; end loop; - -- Now that we know the number of elements, convert to a list. - declare - Sequence : constant Types.Sequence_Ptr - := Types.Sequences.Constructor (Natural (Vector.Length)); - begin - for I in 1 .. Natural (Vector.Length) loop - Sequence.all.Data (I) := Vector (I); - end loop; - return (Kind_List, Sequence); - end; - end Quasiquote_List; + return Result; + end Qq_Seq; - begin -- Quasiquote + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean is + (0 < Sequence'Length + and then Sequence (Sequence'First).Kind = Kind_Symbol + and then Sequence (Sequence'First).Str.all = Symbol); + + begin case Ast.Kind is - when Kind_Vector => - -- When the test is updated, replace Kind_List with Kind_Vector. - return Quasiquote_List (Ast.Sequence.all.Data); when Kind_List => - if 0 < Ast.Sequence.all.Length - and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol - and then Ast.Sequence.all.Data (1).Str.all = "unquote" - then + if Starts_With (Ast.Sequence.all.Data, "unquote") then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Eval (Ast.Sequence.all.Data (2), Env); + return Ast.Sequence.all.Data (2); else - return Quasiquote_List (Ast.Sequence.all.Data); + return Qq_Seq; end if; + when Kind_Vector => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq)); + when Kind_Map | Kind_Symbol => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast)); when others => return Ast; end case; diff --git a/impls/ada.2/step9_try.adb b/impls/ada.2/step9_try.adb index 7c8e3abb..333c7adf 100644 --- a/impls/ada.2/step9_try.adb +++ b/impls/ada.2/step9_try.adb @@ -1,5 +1,4 @@ with Ada.Command_Line; -with Ada.Containers.Vectors; with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; @@ -23,7 +22,6 @@ procedure Step9_Try is use all type Types.Kind_Type; use type Types.Strings.Instance; package ACL renames Ada.Command_Line; - package Vectors is new Ada.Containers.Vectors (Positive, Types.T); function Read return Types.T_Array with Inline; @@ -32,12 +30,7 @@ procedure Step9_Try is function Eval_Builtin (Args : in Types.T_Array) return Types.T; -- The built-in variant needs to see the Repl variable. - function Quasiquote (Ast : in Types.T; - Env : in Envs.Ptr) return Types.T; - -- Mergeing quote and quasiquote into eval with a flag triggering - -- a different behaviour as done for macros in step8 would improve - -- the performances significantly, but Kanaka finds that it breaks - -- too much the step structure shared by all implementations. + function Quasiquote (Ast : in Types.T) return Types.T; procedure Print (Ast : in Types.T) with Inline; @@ -195,9 +188,13 @@ procedure Step9_Try is Macroexpanding := True; Ast := Ast.Sequence.all.Data (2); goto Restart; + elsif First.Str.all = "quasiquoteexpand" then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + return Quasiquote (Ast.Sequence.all.Data (2)); elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Quasiquote (Ast.Sequence.all.Data (2), Env); + Ast := Quasiquote (Ast.Sequence.all.Data (2)); + goto Restart; elsif First.Str.all = "try*" then if Ast.Sequence.all.Length = 2 then Ast := Ast.Sequence.all.Data (2); @@ -345,62 +342,54 @@ procedure Step9_Try is Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); end Print; - function Quasiquote (Ast : in Types.T; - Env : in Envs.Ptr) return Types.T - is + function Quasiquote (Ast : in Types.T) return Types.T is - function Quasiquote_List (List : in Types.T_Array) return Types.T; - -- Handle vectors and lists not starting with unquote. + function Qq_Seq return Types.T; + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean; - function Quasiquote_List (List : in Types.T_Array) return Types.T is - Vector : Vectors.Vector; -- buffer for concatenation - Tmp : Types.T; + function Qq_Seq return Types.T is + Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil)); begin - for Elt of List loop - if Elt.Kind in Kind_List - and then 0 < Elt.Sequence.all.Length - and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol - and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote" + for Elt of reverse Ast.Sequence.all.Data loop + if Elt.Kind = Kind_List + and then Starts_With (Elt.Sequence.all.Data, "splice-unquote") then Err.Check (Elt.Sequence.all.Length = 2, "splice-unquote expects 1 parameter"); - Tmp := Eval (Elt.Sequence.all.Data (2), Env); - Err.Check (Tmp.Kind = Kind_List, - "splice_unquote expects a list"); - for Sub_Elt of Tmp.Sequence.all.Data loop - Vector.Append (Sub_Elt); - end loop; + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("concat")), + Elt.Sequence.all.Data (2), Result)); else - Vector.Append (Quasiquote (Elt, Env)); + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("cons")), + Quasiquote (Elt), Result)); end if; end loop; - -- Now that we know the number of elements, convert to a list. - declare - Sequence : constant Types.Sequence_Ptr - := Types.Sequences.Constructor (Natural (Vector.Length)); - begin - for I in 1 .. Natural (Vector.Length) loop - Sequence.all.Data (I) := Vector (I); - end loop; - return (Kind_List, Sequence); - end; - end Quasiquote_List; + return Result; + end Qq_Seq; - begin -- Quasiquote + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean is + (0 < Sequence'Length + and then Sequence (Sequence'First).Kind = Kind_Symbol + and then Sequence (Sequence'First).Str.all = Symbol); + + begin case Ast.Kind is - when Kind_Vector => - -- When the test is updated, replace Kind_List with Kind_Vector. - return Quasiquote_List (Ast.Sequence.all.Data); when Kind_List => - if 0 < Ast.Sequence.all.Length - and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol - and then Ast.Sequence.all.Data (1).Str.all = "unquote" - then + if Starts_With (Ast.Sequence.all.Data, "unquote") then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Eval (Ast.Sequence.all.Data (2), Env); + return Ast.Sequence.all.Data (2); else - return Quasiquote_List (Ast.Sequence.all.Data); + return Qq_Seq; end if; + when Kind_Vector => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq)); + when Kind_Map | Kind_Symbol => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast)); when others => return Ast; end case; diff --git a/impls/ada.2/stepa_mal.adb b/impls/ada.2/stepa_mal.adb index 3a3d17c6..59a1ad7f 100644 --- a/impls/ada.2/stepa_mal.adb +++ b/impls/ada.2/stepa_mal.adb @@ -1,5 +1,4 @@ with Ada.Command_Line; -with Ada.Containers.Vectors; with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; @@ -24,7 +23,6 @@ procedure StepA_Mal is use all type Types.Kind_Type; use type Types.Strings.Instance; package ACL renames Ada.Command_Line; - package Vectors is new Ada.Containers.Vectors (Positive, Types.T); function Read return Types.T_Array with Inline; @@ -33,12 +31,7 @@ procedure StepA_Mal is function Eval_Builtin (Args : in Types.T_Array) return Types.T; -- The built-in variant needs to see the Repl variable. - function Quasiquote (Ast : in Types.T; - Env : in Envs.Ptr) return Types.T; - -- Mergeing quote and quasiquote into eval with a flag triggering - -- a different behaviour as done for macros in step8 would improve - -- the performances significantly, but Kanaka finds that it breaks - -- too much the step structure shared by all implementations. + function Quasiquote (Ast : in Types.T) return Types.T; procedure Print (Ast : in Types.T) with Inline; @@ -196,9 +189,13 @@ procedure StepA_Mal is Macroexpanding := True; Ast := Ast.Sequence.all.Data (2); goto Restart; + elsif First.Str.all = "quasiquoteexpand" then + Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); + return Quasiquote (Ast.Sequence.all.Data (2)); elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Quasiquote (Ast.Sequence.all.Data (2), Env); + Ast := Quasiquote (Ast.Sequence.all.Data (2)); + goto Restart; elsif First.Str.all = "try*" then if Ast.Sequence.all.Length = 2 then Ast := Ast.Sequence.all.Data (2); @@ -351,62 +348,54 @@ procedure StepA_Mal is Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast)); end Print; - function Quasiquote (Ast : in Types.T; - Env : in Envs.Ptr) return Types.T - is + function Quasiquote (Ast : in Types.T) return Types.T is - function Quasiquote_List (List : in Types.T_Array) return Types.T; - -- Handle vectors and lists not starting with unquote. + function Qq_Seq return Types.T; + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean; - function Quasiquote_List (List : in Types.T_Array) return Types.T is - Vector : Vectors.Vector; -- buffer for concatenation - Tmp : Types.T; + function Qq_Seq return Types.T is + Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil)); begin - for Elt of List loop - if Elt.Kind in Kind_List - and then 0 < Elt.Sequence.all.Length - and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol - and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote" + for Elt of reverse Ast.Sequence.all.Data loop + if Elt.Kind = Kind_List + and then Starts_With (Elt.Sequence.all.Data, "splice-unquote") then Err.Check (Elt.Sequence.all.Length = 2, "splice-unquote expects 1 parameter"); - Tmp := Eval (Elt.Sequence.all.Data (2), Env); - Err.Check (Tmp.Kind = Kind_List, - "splice_unquote expects a list"); - for Sub_Elt of Tmp.Sequence.all.Data loop - Vector.Append (Sub_Elt); - end loop; + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("concat")), + Elt.Sequence.all.Data (2), Result)); else - Vector.Append (Quasiquote (Elt, Env)); + Result := Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("cons")), + Quasiquote (Elt), Result)); end if; end loop; - -- Now that we know the number of elements, convert to a list. - declare - Sequence : constant Types.Sequence_Ptr - := Types.Sequences.Constructor (Natural (Vector.Length)); - begin - for I in 1 .. Natural (Vector.Length) loop - Sequence.all.Data (I) := Vector (I); - end loop; - return (Kind_List, Sequence); - end; - end Quasiquote_List; + return Result; + end Qq_Seq; - begin -- Quasiquote + function Starts_With (Sequence : Types.T_Array; + Symbol : String) return Boolean is + (0 < Sequence'Length + and then Sequence (Sequence'First).Kind = Kind_Symbol + and then Sequence (Sequence'First).Str.all = Symbol); + + begin case Ast.Kind is - when Kind_Vector => - -- When the test is updated, replace Kind_List with Kind_Vector. - return Quasiquote_List (Ast.Sequence.all.Data); when Kind_List => - if 0 < Ast.Sequence.all.Length - and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol - and then Ast.Sequence.all.Data (1).Str.all = "unquote" - then + if Starts_With (Ast.Sequence.all.Data, "unquote") then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Eval (Ast.Sequence.all.Data (2), Env); + return Ast.Sequence.all.Data (2); else - return Quasiquote_List (Ast.Sequence.all.Data); + return Qq_Seq; end if; + when Kind_Vector => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq)); + when Kind_Map | Kind_Symbol => + return Types.Sequences.List + (((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast)); when others => return Ast; end case; diff --git a/impls/ada.2/types-sequences.adb b/impls/ada.2/types-sequences.adb index 8169d7f1..c2604658 100644 --- a/impls/ada.2/types-sequences.adb +++ b/impls/ada.2/types-sequences.adb @@ -208,6 +208,14 @@ package body Types.Sequences is end case; end Rest; + function Vec (Args : in T_Array) return T is + begin + Err.Check (Args'Length = 1 + and then Args (Args'First).Kind in Kind_Sequence, + "expects a sequence"); + return (Kind_Vector, Args (Args'First).Sequence); + end Vec; + function Vector (Args : in T_Array) return T is Ref : constant Sequence_Ptr := Constructor (Args'Length); diff --git a/impls/ada.2/types-sequences.ads b/impls/ada.2/types-sequences.ads index 1b4664d5..f45bdbde 100644 --- a/impls/ada.2/types-sequences.ads +++ b/impls/ada.2/types-sequences.ads @@ -24,6 +24,7 @@ package Types.Sequences is function Map (Args : in T_Array) return T; function Nth (Args : in T_Array) return T; function Rest (Args : in T_Array) return T; + function Vec (Args : in T_Array) return T; function Vector (Args : in T_Array) return T; -- New instances must be created via this constructor. diff --git a/impls/ada/core.adb b/impls/ada/core.adb index 69fd5ae3..caabda09 100644 --- a/impls/ada/core.adb +++ b/impls/ada/core.adb @@ -645,6 +645,25 @@ package body Core is end New_Vector; + function Vec (Rest_Handle : Mal_Handle) + return Types.Mal_Handle is + First_Param : Mal_Handle; + begin + First_Param := Car (Deref_List (Rest_Handle).all); + if Deref (First_Param).Sym_Type /= List then + raise Runtime_Exception with "Expecting a sequence"; + end if; + case Deref_List_Class (First_Param).Get_List_Type is + when Hashed_List => + raise Runtime_Exception with "Expecting a sequence"; + when Vector_List => + return First_Param; + when List_List => + return New_Vector (First_Param); + end case; + end Vec; + + function New_Map (Rest_Handle : Mal_Handle) return Types.Mal_Handle is Rest_List : List_Mal_Type; @@ -1059,6 +1078,10 @@ package body Core is "list?", New_Func_Mal_Type ("list?", Is_List'access)); + Envs.Set (Repl_Env, + "vec", + New_Func_Mal_Type ("vec", Vec'access)); + Envs.Set (Repl_Env, "vector", New_Func_Mal_Type ("vector", New_Vector'access)); diff --git a/impls/ada/step7_quote.adb b/impls/ada/step7_quote.adb index 41308ffa..52babdae 100644 --- a/impls/ada/step7_quote.adb +++ b/impls/ada/step7_quote.adb @@ -100,85 +100,78 @@ procedure Step7_Quote is end Eval_Ast; + function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is + A0 : Mal_Handle; + begin + if Deref (Ast).Sym_Type /= List + or else Deref_List_Class (Ast).Get_List_Type /= List_List + or else Deref_List (Ast).Is_Null + then + return False; + end if; + A0 := Deref_List (Ast).Car; + return Deref (A0).Sym_Type = Sym + and then Deref_Sym (A0).Get_Sym = Symbol; + end Starts_With; function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is - Res, First_Elem, FE_0 : Mal_Handle; + Res, Elt, New_Res : Mal_Handle; L : List_Ptr; - D_Ptr, Ast_P : List_Class_Ptr; begin if Debug then Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); end if; - -- Create a New List for the result... - Res := New_List_Mal_Type (List_List); - L := Deref_List (Res); + if Deref (Param).Sym_Type not in Sym | List then + -- No need to quote, Eval would not affect these anyway. + return Param; + end if; - -- This is the equivalent of Is_Pair if Deref (Param).Sym_Type /= List or else - Is_Null (Deref_List_Class (Param).all) then + Deref_List_Class (Param).Get_List_Type = Hashed_List then -- return a new list containing: a symbol named "quote" and ast. + Res := New_List_Mal_Type (List_List); + L := Deref_List (Res); L.Append (New_Symbol_Mal_Type ("quote")); L.Append (Param); return Res; end if; - -- Ast is a non-empty list at this point. - - Ast_P := Deref_List_Class (Param); - - First_Elem := Car (Ast_P.all); - -- if the first element of ast is a symbol named "unquote": - if Deref (First_Elem).Sym_Type = Sym and then - Deref_Sym (First_Elem).Get_Sym = "unquote" then - + if Starts_With (Param, "unquote") then -- return the second element of ast.` - D_Ptr := Deref_List_Class (Cdr (Ast_P.all)); - return Car (D_Ptr.all); + return Deref_List_Class (Param).Nth (1); end if; - -- if the first element of first element of `ast` (`ast[0][0]`) - -- is a symbol named "splice-unquote" - if Deref (First_Elem).Sym_Type = List and then - not Is_Null (Deref_List_Class (First_Elem).all) then + Res := New_List_Mal_Type (List_List); - D_Ptr := Deref_List_Class (First_Elem); - FE_0 := Car (D_Ptr.all); - - if Deref (FE_0).Sym_Type = Sym and then - Deref_Sym (FE_0).Get_Sym = "splice-unquote" then - - -- return a new list containing: a symbol named "concat", + for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop + Elt := Deref_List_Class (Param).Nth (I); + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + if Starts_With (Elt, "splice-unquote") then L.Append (New_Symbol_Mal_Type ("concat")); - - -- the second element of first element of ast (ast[0][1]), - D_Ptr := Deref_List_Class (Cdr (D_Ptr.all)); - L.Append (Car (D_Ptr.all)); - - -- and the result of calling quasiquote with - -- the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - - return Res; - + L.Append (Deref_List (Elt).Nth (1)); + else + L.Append (New_Symbol_Mal_Type ("cons")); + L.Append (Quasi_Quote_Processing (Elt)); end if; + L.Append (Res); + Res := New_Res; + end loop; + if Deref_List_Class (Param).Get_List_Type = Vector_List then + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + L.Append (New_Symbol_Mal_Type ("vec")); + L.Append (Res); + Res := New_Res; end if; - -- otherwise: return a new list containing: a symbol named "cons", - L.Append (New_Symbol_Mal_Type ("cons")); - - -- the result of calling quasiquote on first element of ast (ast[0]), - L.Append (Quasi_Quote_Processing (Car (Ast_P.all))); - - -- and result of calling quasiquote with the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - return Res; end Quasi_Quote_Processing; @@ -312,6 +305,11 @@ procedure Step7_Quote is return Car (Rest_List); + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then + + return Quasi_Quote_Processing (Car (Rest_List)); + elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quasiquote" then diff --git a/impls/ada/step8_macros.adb b/impls/ada/step8_macros.adb index 2c8857eb..0ab592b3 100644 --- a/impls/ada/step8_macros.adb +++ b/impls/ada/step8_macros.adb @@ -164,85 +164,78 @@ procedure Step8_Macros is end Eval_Ast; + function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is + A0 : Mal_Handle; + begin + if Deref (Ast).Sym_Type /= List + or else Deref_List_Class (Ast).Get_List_Type /= List_List + or else Deref_List (Ast).Is_Null + then + return False; + end if; + A0 := Deref_List (Ast).Car; + return Deref (A0).Sym_Type = Sym + and then Deref_Sym (A0).Get_Sym = Symbol; + end Starts_With; function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is - Res, First_Elem, FE_0 : Mal_Handle; + Res, Elt, New_Res : Mal_Handle; L : List_Ptr; - D_Ptr, Ast_P : List_Class_Ptr; begin if Debug then Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); end if; - -- Create a New List for the result... - Res := New_List_Mal_Type (List_List); - L := Deref_List (Res); + if Deref (Param).Sym_Type not in Sym | List then + -- No need to quote, Eval would not affect these anyway. + return Param; + end if; - -- This is the equivalent of Is_Pair if Deref (Param).Sym_Type /= List or else - Is_Null (Deref_List_Class (Param).all) then + Deref_List_Class (Param).Get_List_Type = Hashed_List then -- return a new list containing: a symbol named "quote" and ast. + Res := New_List_Mal_Type (List_List); + L := Deref_List (Res); L.Append (New_Symbol_Mal_Type ("quote")); L.Append (Param); return Res; end if; - -- Ast is a non-empty list at this point. - - Ast_P := Deref_List_Class (Param); - - First_Elem := Car (Ast_P.all); - -- if the first element of ast is a symbol named "unquote": - if Deref (First_Elem).Sym_Type = Sym and then - Deref_Sym (First_Elem).Get_Sym = "unquote" then - + if Starts_With (Param, "unquote") then -- return the second element of ast.` - D_Ptr := Deref_List_Class (Cdr (Ast_P.all)); - return Car (D_Ptr.all); + return Deref_List_Class (Param).Nth (1); end if; - -- if the first element of first element of `ast` (`ast[0][0]`) - -- is a symbol named "splice-unquote" - if Deref (First_Elem).Sym_Type = List and then - not Is_Null (Deref_List_Class (First_Elem).all) then + Res := New_List_Mal_Type (List_List); - D_Ptr := Deref_List_Class (First_Elem); - FE_0 := Car (D_Ptr.all); - - if Deref (FE_0).Sym_Type = Sym and then - Deref_Sym (FE_0).Get_Sym = "splice-unquote" then - - -- return a new list containing: a symbol named "concat", + for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop + Elt := Deref_List_Class (Param).Nth (I); + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + if Starts_With (Elt, "splice-unquote") then L.Append (New_Symbol_Mal_Type ("concat")); - - -- the second element of first element of ast (ast[0][1]), - D_Ptr := Deref_List_Class (Cdr (D_Ptr.all)); - L.Append (Car (D_Ptr.all)); - - -- and the result of calling quasiquote with - -- the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - - return Res; - + L.Append (Deref_List (Elt).Nth (1)); + else + L.Append (New_Symbol_Mal_Type ("cons")); + L.Append (Quasi_Quote_Processing (Elt)); end if; + L.Append (Res); + Res := New_Res; + end loop; + if Deref_List_Class (Param).Get_List_Type = Vector_List then + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + L.Append (New_Symbol_Mal_Type ("vec")); + L.Append (Res); + Res := New_Res; end if; - -- otherwise: return a new list containing: a symbol named "cons", - L.Append (New_Symbol_Mal_Type ("cons")); - - -- the result of calling quasiquote on first element of ast (ast[0]), - L.Append (Quasi_Quote_Processing (Car (Ast_P.all))); - - -- and result of calling quasiquote with the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - return Res; end Quasi_Quote_Processing; @@ -388,6 +381,11 @@ procedure Step8_Macros is return Car (Rest_List); + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then + + return Quasi_Quote_Processing (Car (Rest_List)); + elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quasiquote" then diff --git a/impls/ada/step9_try.adb b/impls/ada/step9_try.adb index dd01367c..987255eb 100644 --- a/impls/ada/step9_try.adb +++ b/impls/ada/step9_try.adb @@ -164,85 +164,78 @@ procedure Step9_Try is end Eval_Ast; + function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is + A0 : Mal_Handle; + begin + if Deref (Ast).Sym_Type /= List + or else Deref_List_Class (Ast).Get_List_Type /= List_List + or else Deref_List (Ast).Is_Null + then + return False; + end if; + A0 := Deref_List (Ast).Car; + return Deref (A0).Sym_Type = Sym + and then Deref_Sym (A0).Get_Sym = Symbol; + end Starts_With; function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is - Res, First_Elem, FE_0 : Mal_Handle; + Res, Elt, New_Res : Mal_Handle; L : List_Ptr; - D_Ptr, Ast_P : List_Class_Ptr; begin if Debug then Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); end if; - -- Create a New List for the result... - Res := New_List_Mal_Type (List_List); - L := Deref_List (Res); + if Deref (Param).Sym_Type not in Sym | List then + -- No need to quote, Eval would not affect these anyway. + return Param; + end if; - -- This is the equivalent of Is_Pair if Deref (Param).Sym_Type /= List or else - Is_Null (Deref_List_Class (Param).all) then + Deref_List_Class (Param).Get_List_Type = Hashed_List then -- return a new list containing: a symbol named "quote" and ast. + Res := New_List_Mal_Type (List_List); + L := Deref_List (Res); L.Append (New_Symbol_Mal_Type ("quote")); L.Append (Param); return Res; end if; - -- Ast is a non-empty list at this point. - - Ast_P := Deref_List_Class (Param); - - First_Elem := Car (Ast_P.all); - -- if the first element of ast is a symbol named "unquote": - if Deref (First_Elem).Sym_Type = Sym and then - Deref_Sym (First_Elem).Get_Sym = "unquote" then - + if Starts_With (Param, "unquote") then -- return the second element of ast.` - D_Ptr := Deref_List_Class (Cdr (Ast_P.all)); - return Car (D_Ptr.all); + return Deref_List_Class (Param).Nth (1); end if; - -- if the first element of first element of `ast` (`ast[0][0]`) - -- is a symbol named "splice-unquote" - if Deref (First_Elem).Sym_Type = List and then - not Is_Null (Deref_List_Class (First_Elem).all) then + Res := New_List_Mal_Type (List_List); - D_Ptr := Deref_List_Class (First_Elem); - FE_0 := Car (D_Ptr.all); - - if Deref (FE_0).Sym_Type = Sym and then - Deref_Sym (FE_0).Get_Sym = "splice-unquote" then - - -- return a new list containing: a symbol named "concat", + for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop + Elt := Deref_List_Class (Param).Nth (I); + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + if Starts_With (Elt, "splice-unquote") then L.Append (New_Symbol_Mal_Type ("concat")); - - -- the second element of first element of ast (ast[0][1]), - D_Ptr := Deref_List_Class (Cdr (D_Ptr.all)); - L.Append (Car (D_Ptr.all)); - - -- and the result of calling quasiquote with - -- the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - - return Res; - + L.Append (Deref_List (Elt).Nth (1)); + else + L.Append (New_Symbol_Mal_Type ("cons")); + L.Append (Quasi_Quote_Processing (Elt)); end if; + L.Append (Res); + Res := New_Res; + end loop; + if Deref_List_Class (Param).Get_List_Type = Vector_List then + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + L.Append (New_Symbol_Mal_Type ("vec")); + L.Append (Res); + Res := New_Res; end if; - -- otherwise: return a new list containing: a symbol named "cons", - L.Append (New_Symbol_Mal_Type ("cons")); - - -- the result of calling quasiquote on first element of ast (ast[0]), - L.Append (Quasi_Quote_Processing (Car (Ast_P.all))); - - -- and result of calling quasiquote with the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - return Res; end Quasi_Quote_Processing; @@ -414,6 +407,11 @@ procedure Step9_Try is return Car (Rest_List); + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then + + return Quasi_Quote_Processing (Car (Rest_List)); + elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quasiquote" then diff --git a/impls/ada/stepa_mal.adb b/impls/ada/stepa_mal.adb index ce1c1191..454921dd 100644 --- a/impls/ada/stepa_mal.adb +++ b/impls/ada/stepa_mal.adb @@ -164,85 +164,78 @@ procedure StepA_Mal is end Eval_Ast; + function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is + A0 : Mal_Handle; + begin + if Deref (Ast).Sym_Type /= List + or else Deref_List_Class (Ast).Get_List_Type /= List_List + or else Deref_List (Ast).Is_Null + then + return False; + end if; + A0 := Deref_List (Ast).Car; + return Deref (A0).Sym_Type = Sym + and then Deref_Sym (A0).Get_Sym = Symbol; + end Starts_With; function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is - Res, First_Elem, FE_0 : Mal_Handle; + Res, Elt, New_Res : Mal_Handle; L : List_Ptr; - D_Ptr, Ast_P : List_Class_Ptr; begin if Debug then Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String); end if; - -- Create a New List for the result... - Res := New_List_Mal_Type (List_List); - L := Deref_List (Res); + if Deref (Param).Sym_Type not in Sym | List then + -- No need to quote, Eval would not affect these anyway. + return Param; + end if; - -- This is the equivalent of Is_Pair if Deref (Param).Sym_Type /= List or else - Is_Null (Deref_List_Class (Param).all) then + Deref_List_Class (Param).Get_List_Type = Hashed_List then -- return a new list containing: a symbol named "quote" and ast. + Res := New_List_Mal_Type (List_List); + L := Deref_List (Res); L.Append (New_Symbol_Mal_Type ("quote")); L.Append (Param); return Res; end if; - -- Ast is a non-empty list at this point. - - Ast_P := Deref_List_Class (Param); - - First_Elem := Car (Ast_P.all); - -- if the first element of ast is a symbol named "unquote": - if Deref (First_Elem).Sym_Type = Sym and then - Deref_Sym (First_Elem).Get_Sym = "unquote" then - + if Starts_With (Param, "unquote") then -- return the second element of ast.` - D_Ptr := Deref_List_Class (Cdr (Ast_P.all)); - return Car (D_Ptr.all); + return Deref_List_Class (Param).Nth (1); end if; - -- if the first element of first element of `ast` (`ast[0][0]`) - -- is a symbol named "splice-unquote" - if Deref (First_Elem).Sym_Type = List and then - not Is_Null (Deref_List_Class (First_Elem).all) then + Res := New_List_Mal_Type (List_List); - D_Ptr := Deref_List_Class (First_Elem); - FE_0 := Car (D_Ptr.all); - - if Deref (FE_0).Sym_Type = Sym and then - Deref_Sym (FE_0).Get_Sym = "splice-unquote" then - - -- return a new list containing: a symbol named "concat", + for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop + Elt := Deref_List_Class (Param).Nth (I); + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + if Starts_With (Elt, "splice-unquote") then L.Append (New_Symbol_Mal_Type ("concat")); - - -- the second element of first element of ast (ast[0][1]), - D_Ptr := Deref_List_Class (Cdr (D_Ptr.all)); - L.Append (Car (D_Ptr.all)); - - -- and the result of calling quasiquote with - -- the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - - return Res; - + L.Append (Deref_List (Elt).Nth (1)); + else + L.Append (New_Symbol_Mal_Type ("cons")); + L.Append (Quasi_Quote_Processing (Elt)); end if; + L.Append (Res); + Res := New_Res; + end loop; + if Deref_List_Class (Param).Get_List_Type = Vector_List then + New_Res := New_List_Mal_Type (List_List); + L := Deref_List (New_Res); + L.Append (New_Symbol_Mal_Type ("vec")); + L.Append (Res); + Res := New_Res; end if; - -- otherwise: return a new list containing: a symbol named "cons", - L.Append (New_Symbol_Mal_Type ("cons")); - - -- the result of calling quasiquote on first element of ast (ast[0]), - L.Append (Quasi_Quote_Processing (Car (Ast_P.all))); - - -- and result of calling quasiquote with the second through last element of ast. - L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all))); - return Res; end Quasi_Quote_Processing; @@ -414,6 +407,11 @@ procedure StepA_Mal is return Car (Rest_List); + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then + + return Quasi_Quote_Processing (Car (Rest_List)); + elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quasiquote" then diff --git a/impls/awk/core.awk b/impls/awk/core.awk index ee34f165..e7dc0b98 100644 --- a/impls/awk/core.awk +++ b/impls/awk/core.awk @@ -628,6 +628,24 @@ function core_concat(idx, new_idx, new_len, len, i, lst, lst_idx, lst_len, j) return "(" new_idx } +function core_vec(idx, new_idx, len) +{ + len = types_heap[idx]["len"] + if (len != 2) + return "!\"Invalid argument length for builtin function 'vec'. Expects exactly 1 argument, supplied " (len - 1) "." + idx = types_heap[idx][1] + if (idx !~ /^[([]/) { + return "!\"Incompatible type for argument 1 of builtin function 'vec'. Expects list or vector, supplied " types_typename(idx) "." + } + idx = substr(idx, 2) + len = types_heap[idx]["len"] + new_idx = types_allocate() + types_heap[new_idx]["len"] = len + while (len--) + types_addref(types_heap[new_idx][len] = types_heap[idx][len]) + return "[" new_idx +} + function core_nth(idx, lst, num, n, lst_idx) { if (types_heap[idx]["len"] != 3) { @@ -1078,6 +1096,7 @@ function core_init() core_ns["'list"] = "&core_list" core_ns["'list?"] = "&core_listp" + core_ns["'vec"] = "&core_vec" core_ns["'vector"] = "&core_vector" core_ns["'vector?"] = "&core_vectorp" core_ns["'hash-map"] = "&core_hash_map" diff --git a/impls/awk/step7_quote.awk b/impls/awk/step7_quote.awk index d8e963e2..c089c03f 100644 --- a/impls/awk/step7_quote.awk +++ b/impls/awk/step7_quote.awk @@ -9,69 +9,82 @@ function READ(str) return reader_read_str(str) } -function is_pair(ast) +# Return 0, an error or the unquote argument (second element of ast). +function starts_with(ast, sym, idx, len) { - return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0 + if (ast !~ /^\(/) + return 0 + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (!len || types_heap[idx][0] != sym) + return 0 + if (len != 2) + return "!\"'" sym "' expects 1 argument, not " (len - 1) "." + return types_heap[idx][1] } -function quasiquote(ast, i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret) +function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) { - if (!is_pair(ast)) { + if (ast !~ /^[(['{]/) { + return ast + } + if (ast ~ /['\{]/) { new_idx = types_allocate() types_heap[new_idx][0] = "'quote" types_heap[new_idx][1] = ast types_heap[new_idx]["len"] = 2 return "(" new_idx } - idx = substr(ast, 2) - first = types_heap[idx][0] - if (first == "'unquote") { - if (types_heap[idx]["len"] != 2) { - len = types_heap[idx]["len"] - types_release(ast) - return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(ret = types_heap[idx][1]) + ret = starts_with(ast, "'unquote") + if (ret ~ /^!/) { types_release(ast) return ret } - - first_idx = substr(first, 2) - if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") { - if (types_heap[first_idx]["len"] != 2) { - len = types_heap[first_idx]["len"] - types_release(ast) - return "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(first = types_heap[first_idx][1]) - verb = "'concat" - } else { - types_addref(first) - first = quasiquote(first) - if (first ~ /^!/) { - types_release(ast) - return first - } - verb = "'cons" - } - lst_idx = types_allocate() - len = types_heap[idx]["len"] - for (i = 1; i < len; ++i) { - types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i]) - } - types_heap[lst_idx]["len"] = len - 1 - types_release(ast) - ret = quasiquote("(" lst_idx) - if (ret ~ /^!/) { - types_release(first) + if (ret) { + types_addref(ret) + types_release(ast) return ret } - new_idx = types_allocate() - types_heap[new_idx][0] = verb - types_heap[new_idx][1] = first - types_heap[new_idx][2] = ret - types_heap[new_idx]["len"] = 3 + types_heap[new_idx]["len"] = 0 + ast_idx = substr(ast, 2) + for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) { + elt = types_heap[ast_idx][elt_i] + ret = starts_with(elt, "'splice-unquote") + if (ret ~ /^!/) { + types_release("(" new_idx) + types_release(ast) + return ret + } + if (ret) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'concat" + types_heap[new_idx][1] = types_addref(ret) + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } else { + ret = quasiquote(types_addref(elt)) + if (ret ~ /^!/) { + types_release(ast) + return ret + } + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'cons" + types_heap[new_idx][1] = ret + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } + } + if (ast ~ /^\[/) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'vec" + types_heap[new_idx][1] = previous + types_heap[new_idx]["len"] = 2 + } + types_release(ast) return "(" new_idx } @@ -316,6 +329,15 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) types_release(ast) env_release(env) return body + case "'quasiquoteexpand": + env_release(env) + if (len != 2) { + types_release(ast) + return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "." + } + types_addref(body = types_heap[idx][1]) + types_release(ast) + return quasiquote(body) case "'quasiquote": if (len != 2) { types_release(ast) diff --git a/impls/awk/step8_macros.awk b/impls/awk/step8_macros.awk index 6e4a4723..9ac5eb64 100644 --- a/impls/awk/step8_macros.awk +++ b/impls/awk/step8_macros.awk @@ -9,81 +9,93 @@ function READ(str) return reader_read_str(str) } -function is_pair(ast) +# Return 0, an error or the unquote argument (second element of ast). +function starts_with(ast, sym, idx, len) { - return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0 + if (ast !~ /^\(/) + return 0 + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (!len || types_heap[idx][0] != sym) + return 0 + if (len != 2) + return "!\"'" sym "' expects 1 argument, not " (len - 1) "." + return types_heap[idx][1] } -function quasiquote(ast, i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret) +function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) { - if (!is_pair(ast)) { + if (ast !~ /^[(['{]/) { + return ast + } + if (ast ~ /['\{]/) { new_idx = types_allocate() types_heap[new_idx][0] = "'quote" types_heap[new_idx][1] = ast types_heap[new_idx]["len"] = 2 return "(" new_idx } - idx = substr(ast, 2) - first = types_heap[idx][0] - if (first == "'unquote") { - if (types_heap[idx]["len"] != 2) { - len = types_heap[idx]["len"] - types_release(ast) - return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(ret = types_heap[idx][1]) + ret = starts_with(ast, "'unquote") + if (ret ~ /^!/) { types_release(ast) return ret } - - first_idx = substr(first, 2) - if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") { - if (types_heap[first_idx]["len"] != 2) { - len = types_heap[first_idx]["len"] - types_release(ast) - return "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(first = types_heap[first_idx][1]) - verb = "'concat" - } else { - types_addref(first) - first = quasiquote(first) - if (first ~ /^!/) { - types_release(ast) - return first - } - verb = "'cons" - } - lst_idx = types_allocate() - len = types_heap[idx]["len"] - for (i = 1; i < len; ++i) { - types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i]) - } - types_heap[lst_idx]["len"] = len - 1 - types_release(ast) - ret = quasiquote("(" lst_idx) - if (ret ~ /^!/) { - types_release(first) + if (ret) { + types_addref(ret) + types_release(ast) return ret } - new_idx = types_allocate() - types_heap[new_idx][0] = verb - types_heap[new_idx][1] = first - types_heap[new_idx][2] = ret - types_heap[new_idx]["len"] = 3 + types_heap[new_idx]["len"] = 0 + ast_idx = substr(ast, 2) + for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) { + elt = types_heap[ast_idx][elt_i] + ret = starts_with(elt, "'splice-unquote") + if (ret ~ /^!/) { + types_release("(" new_idx) + types_release(ast) + return ret + } + if (ret) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'concat" + types_heap[new_idx][1] = types_addref(ret) + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } else { + ret = quasiquote(types_addref(elt)) + if (ret ~ /^!/) { + types_release(ast) + return ret + } + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'cons" + types_heap[new_idx][1] = ret + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } + } + if (ast ~ /^\[/) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'vec" + types_heap[new_idx][1] = previous + types_heap[new_idx]["len"] = 2 + } + types_release(ast) return "(" new_idx } -function is_macro_call(ast, env, sym, ret, f) +function is_macro_call(ast, env, idx, len, sym, f) { - if (!is_pair(ast)) { - return 0 - } - sym = types_heap[substr(ast, 2)][0] - if (sym !~ /^'/) { - return 0 - } + if (ast !~ /^\(/) return 0 + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 0) return 0 + sym = types_heap[idx][0] + if (sym !~ /^'/) return 0 f = env_get(env, sym) return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"] } @@ -393,6 +405,15 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) types_release(ast) env_release(env) return body + case "'quasiquoteexpand": + env_release(env) + if (len != 2) { + types_release(ast) + return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "." + } + types_addref(body = types_heap[idx][1]) + types_release(ast) + return quasiquote(body) case "'quasiquote": if (len != 2) { types_release(ast) diff --git a/impls/awk/step9_try.awk b/impls/awk/step9_try.awk index f30b2ca4..3ddde8fd 100644 --- a/impls/awk/step9_try.awk +++ b/impls/awk/step9_try.awk @@ -9,81 +9,93 @@ function READ(str) return reader_read_str(str) } -function is_pair(ast) +# Return 0, an error or the unquote argument (second element of ast). +function starts_with(ast, sym, idx, len) { - return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0 + if (ast !~ /^\(/) + return 0 + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (!len || types_heap[idx][0] != sym) + return 0 + if (len != 2) + return "!\"'" sym "' expects 1 argument, not " (len - 1) "." + return types_heap[idx][1] } -function quasiquote(ast, i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret) +function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) { - if (!is_pair(ast)) { + if (ast !~ /^[(['{]/) { + return ast + } + if (ast ~ /['\{]/) { new_idx = types_allocate() types_heap[new_idx][0] = "'quote" types_heap[new_idx][1] = ast types_heap[new_idx]["len"] = 2 return "(" new_idx } - idx = substr(ast, 2) - first = types_heap[idx][0] - if (first == "'unquote") { - if (types_heap[idx]["len"] != 2) { - len = types_heap[idx]["len"] - types_release(ast) - return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(ret = types_heap[idx][1]) + ret = starts_with(ast, "'unquote") + if (ret ~ /^!/) { types_release(ast) return ret } - - first_idx = substr(first, 2) - if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") { - if (types_heap[first_idx]["len"] != 2) { - len = types_heap[first_idx]["len"] - types_release(ast) - return "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(first = types_heap[first_idx][1]) - verb = "'concat" - } else { - types_addref(first) - first = quasiquote(first) - if (first ~ /^!/) { - types_release(ast) - return first - } - verb = "'cons" - } - lst_idx = types_allocate() - len = types_heap[idx]["len"] - for (i = 1; i < len; ++i) { - types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i]) - } - types_heap[lst_idx]["len"] = len - 1 - types_release(ast) - ret = quasiquote("(" lst_idx) - if (ret ~ /^!/) { - types_release(first) + if (ret) { + types_addref(ret) + types_release(ast) return ret } - new_idx = types_allocate() - types_heap[new_idx][0] = verb - types_heap[new_idx][1] = first - types_heap[new_idx][2] = ret - types_heap[new_idx]["len"] = 3 + types_heap[new_idx]["len"] = 0 + ast_idx = substr(ast, 2) + for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) { + elt = types_heap[ast_idx][elt_i] + ret = starts_with(elt, "'splice-unquote") + if (ret ~ /^!/) { + types_release("(" new_idx) + types_release(ast) + return ret + } + if (ret) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'concat" + types_heap[new_idx][1] = types_addref(ret) + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } else { + ret = quasiquote(types_addref(elt)) + if (ret ~ /^!/) { + types_release(ast) + return ret + } + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'cons" + types_heap[new_idx][1] = ret + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } + } + if (ast ~ /^\[/) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'vec" + types_heap[new_idx][1] = previous + types_heap[new_idx]["len"] = 2 + } + types_release(ast) return "(" new_idx } -function is_macro_call(ast, env, sym, ret, f) +function is_macro_call(ast, env, idx, len, sym, f) { - if (!is_pair(ast)) { - return 0 - } - sym = types_heap[substr(ast, 2)][0] - if (sym !~ /^'/) { - return 0 - } + if (ast !~ /^\(/) return 0 + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 0) return 0 + sym = types_heap[idx][0] + if (sym !~ /^'/) return 0 f = env_get(env, sym) return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"] } @@ -447,6 +459,15 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret types_release(ast) env_release(env) return body + case "'quasiquoteexpand": + env_release(env) + if (len != 2) { + types_release(ast) + return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "." + } + types_addref(body = types_heap[idx][1]) + types_release(ast) + return quasiquote(body) case "'quasiquote": if (len != 2) { types_release(ast) diff --git a/impls/awk/stepA_mal.awk b/impls/awk/stepA_mal.awk index bb097eed..5399b26b 100644 --- a/impls/awk/stepA_mal.awk +++ b/impls/awk/stepA_mal.awk @@ -9,81 +9,93 @@ function READ(str) return reader_read_str(str) } -function is_pair(ast) +# Return 0, an error or the unquote argument (second element of ast). +function starts_with(ast, sym, idx, len) { - return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0 + if (ast !~ /^\(/) + return 0 + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (!len || types_heap[idx][0] != sym) + return 0 + if (len != 2) + return "!\"'" sym "' expects 1 argument, not " (len - 1) "." + return types_heap[idx][1] } -function quasiquote(ast, i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret) +function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) { - if (!is_pair(ast)) { + if (ast !~ /^[(['{]/) { + return ast + } + if (ast ~ /['\{]/) { new_idx = types_allocate() types_heap[new_idx][0] = "'quote" types_heap[new_idx][1] = ast types_heap[new_idx]["len"] = 2 return "(" new_idx } - idx = substr(ast, 2) - first = types_heap[idx][0] - if (first == "'unquote") { - if (types_heap[idx]["len"] != 2) { - len = types_heap[idx]["len"] - types_release(ast) - return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(ret = types_heap[idx][1]) + ret = starts_with(ast, "'unquote") + if (ret ~ /^!/) { types_release(ast) return ret } - - first_idx = substr(first, 2) - if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") { - if (types_heap[first_idx]["len"] != 2) { - len = types_heap[first_idx]["len"] - types_release(ast) - return "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(first = types_heap[first_idx][1]) - verb = "'concat" - } else { - types_addref(first) - first = quasiquote(first) - if (first ~ /^!/) { - types_release(ast) - return first - } - verb = "'cons" - } - lst_idx = types_allocate() - len = types_heap[idx]["len"] - for (i = 1; i < len; ++i) { - types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i]) - } - types_heap[lst_idx]["len"] = len - 1 - types_release(ast) - ret = quasiquote("(" lst_idx) - if (ret ~ /^!/) { - types_release(first) + if (ret) { + types_addref(ret) + types_release(ast) return ret } - new_idx = types_allocate() - types_heap[new_idx][0] = verb - types_heap[new_idx][1] = first - types_heap[new_idx][2] = ret - types_heap[new_idx]["len"] = 3 + types_heap[new_idx]["len"] = 0 + ast_idx = substr(ast, 2) + for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) { + elt = types_heap[ast_idx][elt_i] + ret = starts_with(elt, "'splice-unquote") + if (ret ~ /^!/) { + types_release("(" new_idx) + types_release(ast) + return ret + } + if (ret) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'concat" + types_heap[new_idx][1] = types_addref(ret) + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } else { + ret = quasiquote(types_addref(elt)) + if (ret ~ /^!/) { + types_release(ast) + return ret + } + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'cons" + types_heap[new_idx][1] = ret + types_heap[new_idx][2] = previous + types_heap[new_idx]["len"] = 3 + } + } + if (ast ~ /^\[/) { + previous = "(" new_idx + new_idx = types_allocate() + types_heap[new_idx][0] = "'vec" + types_heap[new_idx][1] = previous + types_heap[new_idx]["len"] = 2 + } + types_release(ast) return "(" new_idx } -function is_macro_call(ast, env, sym, ret, f) +function is_macro_call(ast, env, idx, len, sym, f) { - if (!is_pair(ast)) { - return 0 - } - sym = types_heap[substr(ast, 2)][0] - if (sym !~ /^'/) { - return 0 - } + if (ast !~ /^\(/) return 0 + idx = substr(ast, 2) + len = types_heap[idx]["len"] + if (len == 0) return 0 + sym = types_heap[idx][0] + if (sym !~ /^'/) return 0 f = env_get(env, sym) return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"] } @@ -447,6 +459,15 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret types_release(ast) env_release(env) return body + case "'quasiquoteexpand": + env_release(env) + if (len != 2) { + types_release(ast) + return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "." + } + types_addref(body = types_heap[idx][1]) + types_release(ast) + return quasiquote(body) case "'quasiquote": if (len != 2) { types_release(ast) diff --git a/impls/bash/core.sh b/impls/bash/core.sh index 4994d0f3..28119cc7 100644 --- a/impls/bash/core.sh +++ b/impls/bash/core.sh @@ -402,6 +402,7 @@ declare -A core_ns=( [sequential?]=sequential? [cons]=cons [concat]=concat + [vec]=vec [nth]=nth [first]=_first [rest]=_rest diff --git a/impls/bash/step7_quote.sh b/impls/bash/step7_quote.sh index fce62c09..f6076fc8 100755 --- a/impls/bash/step7_quote.sh +++ b/impls/bash/step7_quote.sh @@ -12,42 +12,47 @@ READ () { } # eval -IS_PAIR () { - if _sequential? "${1}"; then - _count "${1}" - [[ "${r}" > 0 ]] && return 0 - fi - return 1 +starts_with () { + _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ] } QUASIQUOTE () { - if ! IS_PAIR "${1}"; then - _symbol quote - _list "${r}" "${1}" - return + _obj_type "$1" + case "$r" in + list) + if starts_with "$1" unquote; then + _nth "$1" 1 + else + qqIter "$1" + fi ;; + vector) + _symbol vec; local a="$r" + qqIter "$1" + _list "$a" "$r" ;; + symbol|hash_map) + _symbol quote + _list "$r" "$1" ;; + *) + r="$1" ;; + esac +} + +qqIter () { + if _empty? "$1"; then + _list else - _nth "${1}" 0; local a0="${r}" - if [[ "${ANON["${a0}"]}" == "unquote" ]]; then - _nth "${1}" 1 - return - elif IS_PAIR "${a0}"; then - _nth "${a0}" 0; local a00="${r}" - if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then - _symbol concat; local a="${r}" - _nth "${a0}" 1; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return - fi + _nth "${1}" 0; local a0="$r" + if starts_with "$a0" splice-unquote; then + _symbol concat; local a="$r" + _nth "$a0" 1; local b="$r" + else + _symbol cons; local a="$r" + QUASIQUOTE "$a0"; local b="$r" fi + _rest "$1" + qqIter "$r" + _list "$a" "$b" "$r" fi - _symbol cons; local a="${r}" - QUASIQUOTE "${a0}"; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return } EVAL_AST () { @@ -115,6 +120,9 @@ EVAL () { quote) r="${a1}" return ;; + quasiquoteexpand) + QUASIQUOTE "${a1}" + return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" diff --git a/impls/bash/step8_macros.sh b/impls/bash/step8_macros.sh index a3c6e98a..c19087d5 100755 --- a/impls/bash/step8_macros.sh +++ b/impls/bash/step8_macros.sh @@ -12,42 +12,47 @@ READ () { } # eval -IS_PAIR () { - if _sequential? "${1}"; then - _count "${1}" - [[ "${r}" > 0 ]] && return 0 - fi - return 1 +starts_with () { + _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ] } QUASIQUOTE () { - if ! IS_PAIR "${1}"; then - _symbol quote - _list "${r}" "${1}" - return + _obj_type "$1" + case "$r" in + list) + if starts_with "$1" unquote; then + _nth "$1" 1 + else + qqIter "$1" + fi ;; + vector) + _symbol vec; local a="$r" + qqIter "$1" + _list "$a" "$r" ;; + symbol|hash_map) + _symbol quote + _list "$r" "$1" ;; + *) + r="$1" ;; + esac +} + +qqIter () { + if _empty? "$1"; then + _list else - _nth "${1}" 0; local a0="${r}" - if [[ "${ANON["${a0}"]}" == "unquote" ]]; then - _nth "${1}" 1 - return - elif IS_PAIR "${a0}"; then - _nth "${a0}" 0; local a00="${r}" - if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then - _symbol concat; local a="${r}" - _nth "${a0}" 1; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return - fi + _nth "${1}" 0; local a0="$r" + if starts_with "$a0" splice-unquote; then + _symbol concat; local a="$r" + _nth "$a0" 1; local b="$r" + else + _symbol cons; local a="$r" + QUASIQUOTE "$a0"; local b="$r" fi + _rest "$1" + qqIter "$r" + _list "$a" "$b" "$r" fi - _symbol cons; local a="${r}" - QUASIQUOTE "${a0}"; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return } IS_MACRO_CALL () { @@ -148,6 +153,9 @@ EVAL () { quote) r="${a1}" return ;; + quasiquoteexpand) + QUASIQUOTE "${a1}" + return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" diff --git a/impls/bash/step9_try.sh b/impls/bash/step9_try.sh index dc5aa974..c73509d8 100755 --- a/impls/bash/step9_try.sh +++ b/impls/bash/step9_try.sh @@ -12,42 +12,47 @@ READ () { } # eval -IS_PAIR () { - if _sequential? "${1}"; then - _count "${1}" - [[ "${r}" > 0 ]] && return 0 - fi - return 1 +starts_with () { + _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ] } QUASIQUOTE () { - if ! IS_PAIR "${1}"; then - _symbol quote - _list "${r}" "${1}" - return + _obj_type "$1" + case "$r" in + list) + if starts_with "$1" unquote; then + _nth "$1" 1 + else + qqIter "$1" + fi ;; + vector) + _symbol vec; local a="$r" + qqIter "$1" + _list "$a" "$r" ;; + symbol|hash_map) + _symbol quote + _list "$r" "$1" ;; + *) + r="$1" ;; + esac +} + +qqIter () { + if _empty? "$1"; then + _list else - _nth "${1}" 0; local a0="${r}" - if [[ "${ANON["${a0}"]}" == "unquote" ]]; then - _nth "${1}" 1 - return - elif IS_PAIR "${a0}"; then - _nth "${a0}" 0; local a00="${r}" - if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then - _symbol concat; local a="${r}" - _nth "${a0}" 1; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return - fi + _nth "${1}" 0; local a0="$r" + if starts_with "$a0" splice-unquote; then + _symbol concat; local a="$r" + _nth "$a0" 1; local b="$r" + else + _symbol cons; local a="$r" + QUASIQUOTE "$a0"; local b="$r" fi + _rest "$1" + qqIter "$r" + _list "$a" "$b" "$r" fi - _symbol cons; local a="${r}" - QUASIQUOTE "${a0}"; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return } IS_MACRO_CALL () { @@ -148,6 +153,9 @@ EVAL () { quote) r="${a1}" return ;; + quasiquoteexpand) + QUASIQUOTE "${a1}" + return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" diff --git a/impls/bash/stepA_mal.sh b/impls/bash/stepA_mal.sh index c6c6587e..d4048336 100755 --- a/impls/bash/stepA_mal.sh +++ b/impls/bash/stepA_mal.sh @@ -12,42 +12,47 @@ READ () { } # eval -IS_PAIR () { - if _sequential? "${1}"; then - _count "${1}" - [[ "${r}" > 0 ]] && return 0 - fi - return 1 +starts_with () { + _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ] } QUASIQUOTE () { - if ! IS_PAIR "${1}"; then - _symbol quote - _list "${r}" "${1}" - return + _obj_type "$1" + case "$r" in + list) + if starts_with "$1" unquote; then + _nth "$1" 1 + else + qqIter "$1" + fi ;; + vector) + _symbol vec; local a="$r" + qqIter "$1" + _list "$a" "$r" ;; + symbol|hash_map) + _symbol quote + _list "$r" "$1" ;; + *) + r="$1" ;; + esac +} + +qqIter () { + if _empty? "$1"; then + _list else - _nth "${1}" 0; local a0="${r}" - if [[ "${ANON["${a0}"]}" == "unquote" ]]; then - _nth "${1}" 1 - return - elif IS_PAIR "${a0}"; then - _nth "${a0}" 0; local a00="${r}" - if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then - _symbol concat; local a="${r}" - _nth "${a0}" 1; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return - fi + _nth "${1}" 0; local a0="$r" + if starts_with "$a0" splice-unquote; then + _symbol concat; local a="$r" + _nth "$a0" 1; local b="$r" + else + _symbol cons; local a="$r" + QUASIQUOTE "$a0"; local b="$r" fi + _rest "$1" + qqIter "$r" + _list "$a" "$b" "$r" fi - _symbol cons; local a="${r}" - QUASIQUOTE "${a0}"; local b="${r}" - _rest "${1}" - QUASIQUOTE "${r}"; local c="${r}" - _list "${a}" "${b}" "${c}" - return } IS_MACRO_CALL () { @@ -148,6 +153,9 @@ EVAL () { quote) r="${a1}" return ;; + quasiquoteexpand) + QUASIQUOTE "${a1}" + return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" diff --git a/impls/bash/types.sh b/impls/bash/types.sh index f171b17c..556cca04 100644 --- a/impls/bash/types.sh +++ b/impls/bash/types.sh @@ -209,6 +209,12 @@ _vector () { } _vector? () { [[ ${1} =~ ^vector_ ]]; } +vec () { + __new_obj_hash_code + r="vector_$r" + ANON["$r"]=${ANON["$1"]} +} + # hash maps (associative arrays) diff --git a/impls/basic/core.in.bas b/impls/basic/core.in.bas index 009d81ab..f2376729 100644 --- a/impls/basic/core.in.bas +++ b/impls/basic/core.in.bas @@ -173,7 +173,7 @@ DO_FUNCTION: REM Switch on the function number REM MEMORY DEBUGGING: - REM IF G>59 THEN ER=-1:E$="unknown function"+STR$(G):RETURN + REM IF G>60 THEN ER=-1:E$="unknown function"+STR$(G):RETURN ON INT(G/10)+1 GOTO DO_1_9,DO_10_19,DO_20_29,DO_30_39,DO_40_49,DO_50_59,DO_60_69 DO_1_9: @@ -189,7 +189,7 @@ DO_FUNCTION: DO_50_59: ON G-49 GOTO DO_CONJ,DO_SEQ,DO_WITH_META,DO_META,DO_ATOM,DO_ATOM_Q,DO_DEREF,DO_RESET_BANG,DO_EVAL,DO_READ_FILE DO_60_69: - ON G-59 GOTO DO_PR_MEMORY_SUMMARY + ON G-59 GOTO DO_VEC,DO_PR_MEMORY_SUMMARY DO_EQUAL_Q: GOSUB EQUAL_Q @@ -333,8 +333,7 @@ DO_FUNCTION: GOSUB LIST_Q GOTO RETURN_TRUE_FALSE DO_VECTOR: - A=AR:T=7:GOSUB FORCE_SEQ_TYPE - RETURN + A=AR:T=7:GOTO FORCE_SEQ_TYPE DO_VECTOR_Q: GOSUB TYPE_A R=T=7 @@ -457,6 +456,8 @@ DO_FUNCTION: GOSUB POP_R: REM pop return value GOSUB POP_Q: REM pop current RETURN + DO_VEC: + T=7:GOTO FORCE_SEQ_TYPE DO_NTH: B=B1 @@ -625,7 +626,8 @@ INIT_CORE_NS: B$="eval":GOSUB INIT_CORE_SET_FUNCTION: REM A=58 B$="read-file":GOSUB INIT_CORE_SET_FUNCTION: REM A=59 - B$="pr-memory-summary":GOSUB INIT_CORE_SET_FUNCTION: REM A=60 + B$="vec":GOSUB INIT_CORE_SET_FUNCTION: REM A=60 + B$="pr-memory-summary":GOSUB INIT_CORE_SET_FUNCTION: REM A=61 REM these are in DO_TCO_FUNCTION A=65 diff --git a/impls/basic/step4_if_fn_do.in.bas b/impls/basic/step4_if_fn_do.in.bas index c3ca6eed..c5a1a9d8 100755 --- a/impls/basic/step4_if_fn_do.in.bas +++ b/impls/basic/step4_if_fn_do.in.bas @@ -234,9 +234,9 @@ SUB EVAL EVAL_DO_FUNCTION: REM regular function - IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO - IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION + IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args diff --git a/impls/basic/step5_tco.in.bas b/impls/basic/step5_tco.in.bas index 184235c0..2c460fd4 100755 --- a/impls/basic/step5_tco.in.bas +++ b/impls/basic/step5_tco.in.bas @@ -258,9 +258,9 @@ SUB EVAL EVAL_DO_FUNCTION: REM regular function - IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO - IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION + IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args diff --git a/impls/basic/step6_file.in.bas b/impls/basic/step6_file.in.bas index 61e9b0ed..bc4c6400 100755 --- a/impls/basic/step6_file.in.bas +++ b/impls/basic/step6_file.in.bas @@ -258,9 +258,9 @@ SUB EVAL EVAL_DO_FUNCTION: REM regular function - IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO - IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION + IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args diff --git a/impls/basic/step7_quote.in.bas b/impls/basic/step7_quote.in.bas index 8233f089..68e546e4 100755 --- a/impls/basic/step7_quote.in.bas +++ b/impls/basic/step7_quote.in.bas @@ -17,74 +17,114 @@ MAL_READ: REM QUASIQUOTE(A) -> R SUB QUASIQUOTE - REM pair? GOSUB TYPE_A - IF T<6 OR T>7 THEN GOTO QQ_QUOTE - IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE + IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED + IF T=5 OR T=8 THEN GOTO QQ_QUOTE + IF T=7 THEN GOTO QQ_VECTOR + IF (Z%(A+1)=0) THEN GOTO QQ_LIST + R=Z%(A+2) + IF (Z%(R)AND 31)<>5 THEN GOTO QQ_LIST + IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST GOTO QQ_UNQUOTE + QQ_UNCHANGED: + R=A + GOSUB INC_REF_R + + GOTO QQ_DONE + QQ_QUOTE: REM ['quote, ast] B$="quote":T=5:GOSUB STRING - B=R:A=A:GOSUB LIST2 + B=R:GOSUB LIST2 + AY=B:GOSUB RELEASE + + GOTO QQ_DONE + + QQ_VECTOR: + REM ['vec, (qq_foldr ast)] + CALL QQ_FOLDR + A=R + B$="vec":T=5:GOSUB STRING:B=R + GOSUB LIST2 + AY=A:GOSUB RELEASE AY=B:GOSUB RELEASE GOTO QQ_DONE QQ_UNQUOTE: - R=Z%(A+2) - IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE - IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE - REM [ast[1]] - R=Z%(Z%(A+1)+2) - GOSUB INC_REF_R + REM [ast[1]] + R=Z%(Z%(A+1)+2) + GOSUB INC_REF_R - GOTO QQ_DONE + GOTO QQ_DONE - QQ_SPLICE_UNQUOTE: + QQ_LIST: + CALL QQ_FOLDR + +QQ_DONE: +END SUB + +REM Quasiquote right fold (A) -> R. +REM Used for unquoted lists (GOTO), vectors (GOSUB), +REM and recursively (GOSUB). +SUB QQ_FOLDR + IF A=0 THEN GOTO QQ_EMPTY + IF Z%(A+1)=0 THEN GOTO QQ_EMPTY + GOTO QQ_NOTEMPTY + + QQ_EMPTY: + REM empty list/vector -> empty list + R=6 + GOSUB INC_REF_R + + GOTO QQ_FOLDR_DONE + + QQ_NOTEMPTY: + REM Execute QQ_FOLDR recursively with (rest A) GOSUB PUSH_A - REM rest of cases call quasiquote on ast[1..] - A=Z%(A+1):CALL QUASIQUOTE - W=R + A=Z%(A+1):CALL QQ_FOLDR GOSUB POP_A - REM set A to ast[0] for last two cases + REM Set A to elt = (first A) A=Z%(A+2) - REM pair? - GOSUB TYPE_A - IF T<6 OR T>7 THEN GOTO QQ_DEFAULT - IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT + REM Quasiquote transition function: + REM A: current element, R: accumulator -> R: new accumulator + REM check if A is a list starting with splice-unquote + GOSUB TYPE_A + IF T<>6 THEN GOTO QQ_DEFAULT + IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT B=Z%(A+2) IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT - IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT - REM ['concat, ast[0][1], quasiquote(ast[1..])] + IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT + REM ('concat, A[1], R) B=Z%(Z%(A+1)+2) + A=R B$="concat":T=5:GOSUB STRING:C=R - A=W:GOSUB LIST3 + GOSUB LIST3 REM release inner quasiquoted since outer list takes ownership AY=A:GOSUB RELEASE AY=C:GOSUB RELEASE - GOTO QQ_DONE - QQ_DEFAULT: - REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])] + GOTO QQ_FOLDR_DONE - Q=W:GOSUB PUSH_Q - REM A set above to ast[0] - CALL QUASIQUOTE - B=R - GOSUB POP_Q:W=Q + QQ_DEFAULT: + REM ('cons, quasiquote(A), R) + GOSUB PUSH_R + CALL QUASIQUOTE + B=R + B$="cons":T=5:GOSUB STRING:C=R + GOSUB POP_A + GOSUB LIST3 + REM release inner quasiquoted since outer list takes ownership + AY=A:GOSUB RELEASE + AY=B:GOSUB RELEASE + AY=C:GOSUB RELEASE - B$="cons":T=5:GOSUB STRING:C=R - A=W:GOSUB LIST3 - REM release inner quasiquoted since outer list takes ownership - AY=A:GOSUB RELEASE - AY=B:GOSUB RELEASE - AY=C:GOSUB RELEASE - QQ_DONE: +QQ_FOLDR_DONE: END SUB @@ -198,6 +238,7 @@ SUB EVAL IF A$="def!" THEN GOTO EVAL_DEF IF A$="let*" THEN GOTO EVAL_LET IF A$="quote" THEN GOTO EVAL_QUOTE + IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE IF A$="do" THEN GOTO EVAL_DO IF A$="if" THEN GOTO EVAL_IF @@ -290,6 +331,11 @@ SUB EVAL GOSUB INC_REF_R GOTO EVAL_RETURN + EVAL_QUASIQUOTEEXPAND: + R=Z%(Z%(A+1)+2) + A=R:CALL QUASIQUOTE + GOTO EVAL_RETURN + EVAL_QUASIQUOTE: R=Z%(Z%(A+1)+2) A=R:CALL QUASIQUOTE @@ -348,9 +394,9 @@ SUB EVAL EVAL_DO_FUNCTION: REM regular function - IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO - IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION + IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args diff --git a/impls/basic/step8_macros.in.bas b/impls/basic/step8_macros.in.bas index 347ebf69..0e7418a3 100755 --- a/impls/basic/step8_macros.in.bas +++ b/impls/basic/step8_macros.in.bas @@ -17,74 +17,114 @@ MAL_READ: REM QUASIQUOTE(A) -> R SUB QUASIQUOTE - REM pair? GOSUB TYPE_A - IF T<6 OR T>7 THEN GOTO QQ_QUOTE - IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE + IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED + IF T=5 OR T=8 THEN GOTO QQ_QUOTE + IF T=7 THEN GOTO QQ_VECTOR + IF (Z%(A+1)=0) THEN GOTO QQ_LIST + R=Z%(A+2) + IF (Z%(R)AND 31)<>5 THEN GOTO QQ_LIST + IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST GOTO QQ_UNQUOTE + QQ_UNCHANGED: + R=A + GOSUB INC_REF_R + + GOTO QQ_DONE + QQ_QUOTE: REM ['quote, ast] B$="quote":T=5:GOSUB STRING - B=R:A=A:GOSUB LIST2 + B=R:GOSUB LIST2 + AY=B:GOSUB RELEASE + + GOTO QQ_DONE + + QQ_VECTOR: + REM ['vec, (qq_foldr ast)] + CALL QQ_FOLDR + A=R + B$="vec":T=5:GOSUB STRING:B=R + GOSUB LIST2 + AY=A:GOSUB RELEASE AY=B:GOSUB RELEASE GOTO QQ_DONE QQ_UNQUOTE: - R=Z%(A+2) - IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE - IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE - REM [ast[1]] - R=Z%(Z%(A+1)+2) - GOSUB INC_REF_R + REM [ast[1]] + R=Z%(Z%(A+1)+2) + GOSUB INC_REF_R - GOTO QQ_DONE + GOTO QQ_DONE - QQ_SPLICE_UNQUOTE: + QQ_LIST: + CALL QQ_FOLDR + +QQ_DONE: +END SUB + +REM Quasiquote right fold (A) -> R. +REM Used for unquoted lists (GOTO), vectors (GOSUB), +REM and recursively (GOSUB). +SUB QQ_FOLDR + IF A=0 THEN GOTO QQ_EMPTY + IF Z%(A+1)=0 THEN GOTO QQ_EMPTY + GOTO QQ_NOTEMPTY + + QQ_EMPTY: + REM empty list/vector -> empty list + R=6 + GOSUB INC_REF_R + + GOTO QQ_FOLDR_DONE + + QQ_NOTEMPTY: + REM Execute QQ_FOLDR recursively with (rest A) GOSUB PUSH_A - REM rest of cases call quasiquote on ast[1..] - A=Z%(A+1):CALL QUASIQUOTE - W=R + A=Z%(A+1):CALL QQ_FOLDR GOSUB POP_A - REM set A to ast[0] for last two cases + REM Set A to elt = (first A) A=Z%(A+2) - REM pair? - GOSUB TYPE_A - IF T<6 OR T>7 THEN GOTO QQ_DEFAULT - IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT + REM Quasiquote transition function: + REM A: current element, R: accumulator -> R: new accumulator + REM check if A is a list starting with splice-unquote + GOSUB TYPE_A + IF T<>6 THEN GOTO QQ_DEFAULT + IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT B=Z%(A+2) IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT - IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT - REM ['concat, ast[0][1], quasiquote(ast[1..])] + IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT + REM ('concat, A[1], R) B=Z%(Z%(A+1)+2) + A=R B$="concat":T=5:GOSUB STRING:C=R - A=W:GOSUB LIST3 + GOSUB LIST3 REM release inner quasiquoted since outer list takes ownership AY=A:GOSUB RELEASE AY=C:GOSUB RELEASE - GOTO QQ_DONE - QQ_DEFAULT: - REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])] + GOTO QQ_FOLDR_DONE - Q=W:GOSUB PUSH_Q - REM A set above to ast[0] - CALL QUASIQUOTE - B=R - GOSUB POP_Q:W=Q + QQ_DEFAULT: + REM ('cons, quasiquote(A), R) + GOSUB PUSH_R + CALL QUASIQUOTE + B=R + B$="cons":T=5:GOSUB STRING:C=R + GOSUB POP_A + GOSUB LIST3 + REM release inner quasiquoted since outer list takes ownership + AY=A:GOSUB RELEASE + AY=B:GOSUB RELEASE + AY=C:GOSUB RELEASE - B$="cons":T=5:GOSUB STRING:C=R - A=W:GOSUB LIST3 - REM release inner quasiquoted since outer list takes ownership - AY=A:GOSUB RELEASE - AY=B:GOSUB RELEASE - AY=C:GOSUB RELEASE - QQ_DONE: +QQ_FOLDR_DONE: END SUB REM MACROEXPAND(A, E) -> A: @@ -238,6 +278,7 @@ SUB EVAL IF A$="def!" THEN GOTO EVAL_DEF IF A$="let*" THEN GOTO EVAL_LET IF A$="quote" THEN GOTO EVAL_QUOTE + IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND @@ -332,6 +373,11 @@ SUB EVAL GOSUB INC_REF_R GOTO EVAL_RETURN + EVAL_QUASIQUOTEEXPAND: + R=Z%(Z%(A+1)+2) + A=R:CALL QUASIQUOTE + GOTO EVAL_RETURN + EVAL_QUASIQUOTE: R=Z%(Z%(A+1)+2) A=R:CALL QUASIQUOTE @@ -415,9 +461,9 @@ SUB EVAL EVAL_DO_FUNCTION: REM regular function - IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO - IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION + IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args diff --git a/impls/basic/step9_try.in.bas b/impls/basic/step9_try.in.bas index ac0bbf84..51b9c089 100755 --- a/impls/basic/step9_try.in.bas +++ b/impls/basic/step9_try.in.bas @@ -17,74 +17,114 @@ MAL_READ: REM QUASIQUOTE(A) -> R SUB QUASIQUOTE - REM pair? GOSUB TYPE_A - IF T<6 OR T>7 THEN GOTO QQ_QUOTE - IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE + IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED + IF T=5 OR T=8 THEN GOTO QQ_QUOTE + IF T=7 THEN GOTO QQ_VECTOR + IF (Z%(A+1)=0) THEN GOTO QQ_LIST + R=Z%(A+2) + IF (Z%(R)AND 31)<>5 THEN GOTO QQ_LIST + IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST GOTO QQ_UNQUOTE + QQ_UNCHANGED: + R=A + GOSUB INC_REF_R + + GOTO QQ_DONE + QQ_QUOTE: REM ['quote, ast] B$="quote":T=5:GOSUB STRING - B=R:A=A:GOSUB LIST2 + B=R:GOSUB LIST2 + AY=B:GOSUB RELEASE + + GOTO QQ_DONE + + QQ_VECTOR: + REM ['vec, (qq_foldr ast)] + CALL QQ_FOLDR + A=R + B$="vec":T=5:GOSUB STRING:B=R + GOSUB LIST2 + AY=A:GOSUB RELEASE AY=B:GOSUB RELEASE GOTO QQ_DONE QQ_UNQUOTE: - R=Z%(A+2) - IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE - IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE - REM [ast[1]] - R=Z%(Z%(A+1)+2) - GOSUB INC_REF_R + REM [ast[1]] + R=Z%(Z%(A+1)+2) + GOSUB INC_REF_R - GOTO QQ_DONE + GOTO QQ_DONE - QQ_SPLICE_UNQUOTE: + QQ_LIST: + CALL QQ_FOLDR + +QQ_DONE: +END SUB + +REM Quasiquote right fold (A) -> R. +REM Used for unquoted lists (GOTO), vectors (GOSUB), +REM and recursively (GOSUB). +SUB QQ_FOLDR + IF A=0 THEN GOTO QQ_EMPTY + IF Z%(A+1)=0 THEN GOTO QQ_EMPTY + GOTO QQ_NOTEMPTY + + QQ_EMPTY: + REM empty list/vector -> empty list + R=6 + GOSUB INC_REF_R + + GOTO QQ_FOLDR_DONE + + QQ_NOTEMPTY: + REM Execute QQ_FOLDR recursively with (rest A) GOSUB PUSH_A - REM rest of cases call quasiquote on ast[1..] - A=Z%(A+1):CALL QUASIQUOTE - W=R + A=Z%(A+1):CALL QQ_FOLDR GOSUB POP_A - REM set A to ast[0] for last two cases + REM Set A to elt = (first A) A=Z%(A+2) - REM pair? - GOSUB TYPE_A - IF T<6 OR T>7 THEN GOTO QQ_DEFAULT - IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT + REM Quasiquote transition function: + REM A: current element, R: accumulator -> R: new accumulator + REM check if A is a list starting with splice-unquote + GOSUB TYPE_A + IF T<>6 THEN GOTO QQ_DEFAULT + IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT B=Z%(A+2) IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT - IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT - REM ['concat, ast[0][1], quasiquote(ast[1..])] + IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT + REM ('concat, A[1], R) B=Z%(Z%(A+1)+2) + A=R B$="concat":T=5:GOSUB STRING:C=R - A=W:GOSUB LIST3 + GOSUB LIST3 REM release inner quasiquoted since outer list takes ownership AY=A:GOSUB RELEASE AY=C:GOSUB RELEASE - GOTO QQ_DONE - QQ_DEFAULT: - REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])] + GOTO QQ_FOLDR_DONE - Q=W:GOSUB PUSH_Q - REM A set above to ast[0] - CALL QUASIQUOTE - B=R - GOSUB POP_Q:W=Q + QQ_DEFAULT: + REM ('cons, quasiquote(A), R) + GOSUB PUSH_R + CALL QUASIQUOTE + B=R + B$="cons":T=5:GOSUB STRING:C=R + GOSUB POP_A + GOSUB LIST3 + REM release inner quasiquoted since outer list takes ownership + AY=A:GOSUB RELEASE + AY=B:GOSUB RELEASE + AY=C:GOSUB RELEASE - B$="cons":T=5:GOSUB STRING:C=R - A=W:GOSUB LIST3 - REM release inner quasiquoted since outer list takes ownership - AY=A:GOSUB RELEASE - AY=B:GOSUB RELEASE - AY=C:GOSUB RELEASE - QQ_DONE: +QQ_FOLDR_DONE: END SUB REM MACROEXPAND(A, E) -> A: @@ -238,6 +278,7 @@ SUB EVAL IF A$="def!" THEN GOTO EVAL_DEF IF A$="let*" THEN GOTO EVAL_LET IF A$="quote" THEN GOTO EVAL_QUOTE + IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND @@ -333,6 +374,11 @@ SUB EVAL GOSUB INC_REF_R GOTO EVAL_RETURN + EVAL_QUASIQUOTEEXPAND: + R=Z%(Z%(A+1)+2) + A=R:CALL QUASIQUOTE + GOTO EVAL_RETURN + EVAL_QUASIQUOTE: R=Z%(Z%(A+1)+2) A=R:CALL QUASIQUOTE @@ -448,9 +494,9 @@ SUB EVAL EVAL_DO_FUNCTION: REM regular function - IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO - IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION + IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args diff --git a/impls/basic/stepA_mal.in.bas b/impls/basic/stepA_mal.in.bas index 2b4e8a6d..9a3790ff 100755 --- a/impls/basic/stepA_mal.in.bas +++ b/impls/basic/stepA_mal.in.bas @@ -14,74 +14,114 @@ REM READ is inlined in RE REM QUASIQUOTE(A) -> R SUB QUASIQUOTE - REM pair? GOSUB TYPE_A - IF T<6 OR T>7 THEN GOTO QQ_QUOTE - IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE + IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED + IF T=5 OR T=8 THEN GOTO QQ_QUOTE + IF T=7 THEN GOTO QQ_VECTOR + IF (Z%(A+1)=0) THEN GOTO QQ_LIST + R=Z%(A+2) + IF (Z%(R)AND 31)<>5 THEN GOTO QQ_LIST + IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST GOTO QQ_UNQUOTE + QQ_UNCHANGED: + R=A + GOSUB INC_REF_R + + GOTO QQ_DONE + QQ_QUOTE: REM ['quote, ast] B$="quote":T=5:GOSUB STRING - B=R:A=A:GOSUB LIST2 + B=R:GOSUB LIST2 + AY=B:GOSUB RELEASE + + GOTO QQ_DONE + + QQ_VECTOR: + REM ['vec, (qq_foldr ast)] + CALL QQ_FOLDR + A=R + B$="vec":T=5:GOSUB STRING:B=R + GOSUB LIST2 + AY=A:GOSUB RELEASE AY=B:GOSUB RELEASE GOTO QQ_DONE QQ_UNQUOTE: - R=Z%(A+2) - IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE - IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE - REM [ast[1]] - R=Z%(Z%(A+1)+2) - GOSUB INC_REF_R + REM [ast[1]] + R=Z%(Z%(A+1)+2) + GOSUB INC_REF_R - GOTO QQ_DONE + GOTO QQ_DONE - QQ_SPLICE_UNQUOTE: + QQ_LIST: + CALL QQ_FOLDR + +QQ_DONE: +END SUB + +REM Quasiquote right fold (A) -> R. +REM Used for unquoted lists (GOTO), vectors (GOSUB), +REM and recursively (GOSUB). +SUB QQ_FOLDR + IF A=0 THEN GOTO QQ_EMPTY + IF Z%(A+1)=0 THEN GOTO QQ_EMPTY + GOTO QQ_NOTEMPTY + + QQ_EMPTY: + REM empty list/vector -> empty list + R=6 + GOSUB INC_REF_R + + GOTO QQ_FOLDR_DONE + + QQ_NOTEMPTY: + REM Execute QQ_FOLDR recursively with (rest A) GOSUB PUSH_A - REM rest of cases call quasiquote on ast[1..] - A=Z%(A+1):CALL QUASIQUOTE - W=R + A=Z%(A+1):CALL QQ_FOLDR GOSUB POP_A - REM set A to ast[0] for last two cases + REM Set A to elt = (first A) A=Z%(A+2) - REM pair? - GOSUB TYPE_A - IF T<6 OR T>7 THEN GOTO QQ_DEFAULT - IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT + REM Quasiquote transition function: + REM A: current element, R: accumulator -> R: new accumulator + REM check if A is a list starting with splice-unquote + GOSUB TYPE_A + IF T<>6 THEN GOTO QQ_DEFAULT + IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT B=Z%(A+2) IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT - IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT - REM ['concat, ast[0][1], quasiquote(ast[1..])] + IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT + REM ('concat, A[1], R) B=Z%(Z%(A+1)+2) + A=R B$="concat":T=5:GOSUB STRING:C=R - A=W:GOSUB LIST3 + GOSUB LIST3 REM release inner quasiquoted since outer list takes ownership AY=A:GOSUB RELEASE AY=C:GOSUB RELEASE - GOTO QQ_DONE - QQ_DEFAULT: - REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])] + GOTO QQ_FOLDR_DONE - Q=W:GOSUB PUSH_Q - REM A set above to ast[0] - CALL QUASIQUOTE - B=R - GOSUB POP_Q:W=Q + QQ_DEFAULT: + REM ('cons, quasiquote(A), R) + GOSUB PUSH_R + CALL QUASIQUOTE + B=R + B$="cons":T=5:GOSUB STRING:C=R + GOSUB POP_A + GOSUB LIST3 + REM release inner quasiquoted since outer list takes ownership + AY=A:GOSUB RELEASE + AY=B:GOSUB RELEASE + AY=C:GOSUB RELEASE - B$="cons":T=5:GOSUB STRING:C=R - A=W:GOSUB LIST3 - REM release inner quasiquoted since outer list takes ownership - AY=A:GOSUB RELEASE - AY=B:GOSUB RELEASE - AY=C:GOSUB RELEASE - QQ_DONE: +QQ_FOLDR_DONE: END SUB REM MACROEXPAND(A, E) -> A: @@ -235,6 +275,7 @@ SUB EVAL IF A$="def!" THEN GOTO EVAL_DEF IF A$="let*" THEN GOTO EVAL_LET IF A$="quote" THEN GOTO EVAL_QUOTE + IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND @@ -330,6 +371,11 @@ SUB EVAL GOSUB INC_REF_R GOTO EVAL_RETURN + EVAL_QUASIQUOTEEXPAND: + R=Z%(Z%(A+1)+2) + A=R:CALL QUASIQUOTE + GOTO EVAL_RETURN + EVAL_QUASIQUOTE: R=Z%(Z%(A+1)+2) A=R:CALL QUASIQUOTE @@ -445,9 +491,9 @@ SUB EVAL EVAL_DO_FUNCTION: REM regular function - IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO - IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION + IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args diff --git a/impls/bbc-basic/core.bas b/impls/bbc-basic/core.bas index a4e49722..37cdbc2a 100644 --- a/impls/bbc-basic/core.bas +++ b/impls/bbc-basic/core.bas @@ -286,6 +286,10 @@ DEF FNcore_call(fn%, args%) WHEN 60 PROCcore_prepare_args("?", "seq") =FNcore_seq(args%(0)) + DATA vec, 61 + WHEN 61 + PROCcore_prepare_args("l", "vec") + =FNas_vector(args%(0)) DATA "", -1 ENDCASE ERROR &40E809F1, "Call to non-existent core function" diff --git a/impls/bbc-basic/step7_quote.bas b/impls/bbc-basic/step7_quote.bas index bfab04b4..5d3fdb1b 100644 --- a/impls/bbc-basic/step7_quote.bas +++ b/impls/bbc-basic/step7_quote.bas @@ -53,25 +53,33 @@ END DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) -DEF FNis_pair(val%) -=FNis_seq(val%) AND NOT FNis_empty(val%) +DEF FNstarts_with(ast%, sym$) + LOCAL a0% + IF NOT FNis_list(ast%) THEN =FALSE + a0% = FNfirst(ast%) + IF NOT FNis_symbol(a0%) THEN =FALSE + =FNunbox_symbol(a0%) = sym$ + +DEF FNqq_elts(seq%) + LOCAL elt%, acc% + IF FNis_empty(seq%) THEN =FNempty + elt% = FNfirst(seq%) + acc% = FNqq_elts(FNrest(seq%)) + IF FNstarts_with(elt%, "splice-unquote") THEN + =FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%) + ENDIF + =FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%) DEF FNquasiquote(ast%) - LOCAL car%, caar% - IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%) - car% = FNfirst(ast%) - IF FNis_symbol(car%) THEN - IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1) + IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1) + IF FNis_list(ast%) THEN =FNqq_elts(ast%) + IF FNis_vector(ast%) THEN + =FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%)) ENDIF - IF FNis_pair(car%) THEN - caar% = FNfirst(car%) - IF FNis_symbol(caar%) THEN - IF FNunbox_symbol(caar%) = "splice-unquote" THEN - =FNalloc_list3(FNalloc_symbol("concat"), FNnth(car%, 1), FNquasiquote(FNrest(ast%))) - ENDIF - ENDIF + IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN + =FNalloc_list2(FNalloc_symbol("quote"), ast%) ENDIF -=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%))) + =ast% DEF FNEVAL(ast%, env%) PROCgc_enter @@ -124,6 +132,8 @@ DEF FNEVAL_(ast%, env%) =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) WHEN "quote" =FNnth(ast%, 1) + WHEN "quasiquoteexpand" + = FNquasiquote(FNnth(ast%, 1)) WHEN "quasiquote" ast% = FNquasiquote(FNnth(ast%, 1)) REM Loop round for tail-call optimisation diff --git a/impls/bbc-basic/step8_macros.bas b/impls/bbc-basic/step8_macros.bas index 7cddc5af..5f50ab28 100644 --- a/impls/bbc-basic/step8_macros.bas +++ b/impls/bbc-basic/step8_macros.bas @@ -54,25 +54,33 @@ END DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) -DEF FNis_pair(val%) -=FNis_seq(val%) AND NOT FNis_empty(val%) +DEF FNstarts_with(ast%, sym$) + LOCAL a0% + IF NOT FNis_list(ast%) THEN =FALSE + a0% = FNfirst(ast%) + IF NOT FNis_symbol(a0%) THEN =FALSE + =FNunbox_symbol(a0%) = sym$ + +DEF FNqq_elts(seq%) + LOCAL elt%, acc% + IF FNis_empty(seq%) THEN =FNempty + elt% = FNfirst(seq%) + acc% = FNqq_elts(FNrest(seq%)) + IF FNstarts_with(elt%, "splice-unquote") THEN + =FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%) + ENDIF + =FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%) DEF FNquasiquote(ast%) - LOCAL car%, caar% - IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%) - car% = FNfirst(ast%) - IF FNis_symbol(car%) THEN - IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1) + IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1) + IF FNis_list(ast%) THEN =FNqq_elts(ast%) + IF FNis_vector(ast%) THEN + =FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%)) ENDIF - IF FNis_pair(car%) THEN - caar% = FNfirst(car%) - IF FNis_symbol(caar%) THEN - IF FNunbox_symbol(caar%) = "splice-unquote" THEN - =FNalloc_list3(FNalloc_symbol("concat"), FNnth(car%, 1), FNquasiquote(FNrest(ast%))) - ENDIF - ENDIF + IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN + =FNalloc_list2(FNalloc_symbol("quote"), ast%) ENDIF -=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%))) + =ast% DEF FNis_macro_call(ast%, env%) LOCAL car%, val% @@ -153,6 +161,8 @@ DEF FNEVAL_(ast%, env%) =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) WHEN "quote" =FNnth(ast%, 1) + WHEN "quasiquoteexpand" + = FNquasiquote(FNnth(ast%, 1)) WHEN "quasiquote" ast% = FNquasiquote(FNnth(ast%, 1)) REM Loop round for tail-call optimisation diff --git a/impls/bbc-basic/step9_try.bas b/impls/bbc-basic/step9_try.bas index 1fa6323d..61d1036f 100644 --- a/impls/bbc-basic/step9_try.bas +++ b/impls/bbc-basic/step9_try.bas @@ -54,25 +54,33 @@ END DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) -DEF FNis_pair(val%) -=FNis_seq(val%) AND NOT FNis_empty(val%) +DEF FNstarts_with(ast%, sym$) + LOCAL a0% + IF NOT FNis_list(ast%) THEN =FALSE + a0% = FNfirst(ast%) + IF NOT FNis_symbol(a0%) THEN =FALSE + =FNunbox_symbol(a0%) = sym$ + +DEF FNqq_elts(seq%) + LOCAL elt%, acc% + IF FNis_empty(seq%) THEN =FNempty + elt% = FNfirst(seq%) + acc% = FNqq_elts(FNrest(seq%)) + IF FNstarts_with(elt%, "splice-unquote") THEN + =FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%) + ENDIF + =FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%) DEF FNquasiquote(ast%) - LOCAL car%, caar% - IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%) - car% = FNfirst(ast%) - IF FNis_symbol(car%) THEN - IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1) + IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1) + IF FNis_list(ast%) THEN =FNqq_elts(ast%) + IF FNis_vector(ast%) THEN + =FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%)) ENDIF - IF FNis_pair(car%) THEN - caar% = FNfirst(car%) - IF FNis_symbol(caar%) THEN - IF FNunbox_symbol(caar%) = "splice-unquote" THEN - =FNalloc_list3(FNalloc_symbol("concat"), FNnth(car%, 1), FNquasiquote(FNrest(ast%))) - ENDIF - ENDIF + IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN + =FNalloc_list2(FNalloc_symbol("quote"), ast%) ENDIF -=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%))) + =ast% DEF FNis_macro_call(ast%, env%) LOCAL car%, val% @@ -195,6 +203,8 @@ DEF FNEVAL_(ast%, env%) =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) WHEN "quote" =FNnth(ast%, 1) + WHEN "quasiquoteexpand" + = FNquasiquote(FNnth(ast%, 1)) WHEN "quasiquote" ast% = FNquasiquote(FNnth(ast%, 1)) REM Loop round for tail-call optimisation diff --git a/impls/bbc-basic/stepA_mal.bas b/impls/bbc-basic/stepA_mal.bas index 40b2ef26..2ca19477 100644 --- a/impls/bbc-basic/stepA_mal.bas +++ b/impls/bbc-basic/stepA_mal.bas @@ -56,25 +56,33 @@ END DEF FNREAD(a$) =FNread_str(FNalloc_string(a$)) -DEF FNis_pair(val%) -=FNis_seq(val%) AND NOT FNis_empty(val%) +DEF FNstarts_with(ast%, sym$) + LOCAL a0% + IF NOT FNis_list(ast%) THEN =FALSE + a0% = FNfirst(ast%) + IF NOT FNis_symbol(a0%) THEN =FALSE + =FNunbox_symbol(a0%) = sym$ + +DEF FNqq_elts(seq%) + LOCAL elt%, acc% + IF FNis_empty(seq%) THEN =FNempty + elt% = FNfirst(seq%) + acc% = FNqq_elts(FNrest(seq%)) + IF FNstarts_with(elt%, "splice-unquote") THEN + =FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%) + ENDIF + =FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%) DEF FNquasiquote(ast%) - LOCAL car%, caar% - IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%) - car% = FNfirst(ast%) - IF FNis_symbol(car%) THEN - IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1) + IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1) + IF FNis_list(ast%) THEN =FNqq_elts(ast%) + IF FNis_vector(ast%) THEN + =FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%)) ENDIF - IF FNis_pair(car%) THEN - caar% = FNfirst(car%) - IF FNis_symbol(caar%) THEN - IF FNunbox_symbol(caar%) = "splice-unquote" THEN - =FNalloc_list3(FNalloc_symbol("concat"), FNnth(car%, 1), FNquasiquote(FNrest(ast%))) - ENDIF - ENDIF + IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN + =FNalloc_list2(FNalloc_symbol("quote"), ast%) ENDIF -=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%))) + =ast% DEF FNis_macro_call(ast%, env%) LOCAL car%, val% @@ -197,6 +205,8 @@ DEF FNEVAL_(ast%, env%) =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) WHEN "quote" =FNnth(ast%, 1) + WHEN "quasiquoteexpand" + = FNquasiquote(FNnth(ast%, 1)) WHEN "quasiquote" ast% = FNquasiquote(FNnth(ast%, 1)) REM Loop round for tail-call optimisation diff --git a/impls/c/core.c b/impls/c/core.c index 3cfbb2e4..72a4a593 100644 --- a/impls/c/core.c +++ b/impls/c/core.c @@ -330,6 +330,24 @@ MalVal *concat(MalVal *args) { return lst; } +MalVal *vec(MalVal *seq) { + switch(seq->type) { + case MAL_VECTOR: + return seq; + case MAL_LIST: { + const GArray * const src = seq->val.array; + const int len = src->len; + GArray * const dst = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len); + int i; + for (i=0; ival.array, MalVal*, i)); + return malval_new_list(MAL_VECTOR, dst); + } + default: + _error("vec called with non-sequential"); + } +} + MalVal *nth(MalVal *seq, MalVal *idx) { return _nth(seq, idx->val.intnum); } @@ -505,7 +523,7 @@ MalVal *swap_BANG(MalVal *args) { -core_ns_entry core_ns[61] = { +core_ns_entry core_ns[] = { {"=", (void*(*)(void*))equal_Q, 2}, {"throw", (void*(*)(void*))throw, 1}, {"nil?", (void*(*)(void*))nil_Q, 1}, @@ -553,6 +571,7 @@ core_ns_entry core_ns[61] = { {"sequential?", (void*(*)(void*))sequential_Q, 1}, {"cons", (void*(*)(void*))cons, 2}, {"concat", (void*(*)(void*))concat, -1}, + {"vec", (void*(*)(void*))vec, 1}, {"nth", (void*(*)(void*))nth, 2}, {"first", (void*(*)(void*))_first, 1}, {"rest", (void*(*)(void*))_rest, 1}, diff --git a/impls/c/core.h b/impls/c/core.h index 4c8909b6..2e871d6e 100644 --- a/impls/c/core.h +++ b/impls/c/core.h @@ -10,6 +10,6 @@ typedef struct { int arg_cnt; } core_ns_entry; -extern core_ns_entry core_ns[61]; +extern core_ns_entry core_ns[62]; #endif diff --git a/impls/c/step7_quote.c b/impls/c/step7_quote.c index 844a3ed9..a42f9780 100644 --- a/impls/c/step7_quote.c +++ b/impls/c/step7_quote.c @@ -10,6 +10,7 @@ // Declarations MalVal *EVAL(MalVal *ast, Env *env); +MalVal *quasiquote(MalVal *ast); // read MalVal *READ(char prompt[], char *str) { @@ -30,30 +31,40 @@ MalVal *READ(char prompt[], char *str) { } // eval -int is_pair(MalVal *x) { - return _sequential_Q(x) && (_count(x) > 0); +int starts_with(MalVal *ast, const char *sym) { + if (ast->type != MAL_LIST) + return 0; + const MalVal * const a0 = _first(ast); + return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string); +} + +MalVal *qq_iter(GArray *xs) { + MalVal *acc = _listX(0); + int i; + for (i=xs->len-1; 0<=i; i--) { + MalVal * const elt = g_array_index(xs, MalVal*, i); + if (starts_with(elt, "splice-unquote")) + acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc); + else + acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc); + } + return acc; } MalVal *quasiquote(MalVal *ast) { - if (!is_pair(ast)) { - return _listX(2, malval_new_symbol("quote"), ast); - } else { - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("unquote", a0->val.string) == 0) { + switch (ast->type) { + case MAL_LIST: + if (starts_with(ast, "unquote")) return _nth(ast, 1); - } else if (is_pair(a0)) { - MalVal *a00 = _nth(a0, 0); - if ((a00->type & MAL_SYMBOL) && - strcmp("splice-unquote", a00->val.string) == 0) { - return _listX(3, malval_new_symbol("concat"), - _nth(a0, 1), - quasiquote(_rest(ast))); - } - } - return _listX(3, malval_new_symbol("cons"), - quasiquote(a0), - quasiquote(_rest(ast))); + else + return qq_iter(ast->val.array); + case MAL_VECTOR: + return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array)); + case MAL_HASH_MAP: + case MAL_SYMBOL: + return _listX(2, malval_new_symbol("quote"), ast); + default: + return ast; } } @@ -137,6 +148,9 @@ MalVal *EVAL(MalVal *ast, Env *env) { strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quasiquoteexpand", a0->val.string) == 0) { + return quasiquote(_nth(ast, 1)); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); diff --git a/impls/c/step8_macros.c b/impls/c/step8_macros.c index a7953361..ac5a3b0f 100644 --- a/impls/c/step8_macros.c +++ b/impls/c/step8_macros.c @@ -10,6 +10,7 @@ // Declarations MalVal *EVAL(MalVal *ast, Env *env); +MalVal *quasiquote(MalVal *ast); MalVal *macroexpand(MalVal *ast, Env *env); // read @@ -31,30 +32,40 @@ MalVal *READ(char prompt[], char *str) { } // eval -int is_pair(MalVal *x) { - return _sequential_Q(x) && (_count(x) > 0); +int starts_with(MalVal *ast, const char *sym) { + if (ast->type != MAL_LIST) + return 0; + const MalVal * const a0 = _first(ast); + return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string); +} + +MalVal *qq_iter(GArray *xs) { + MalVal *acc = _listX(0); + int i; + for (i=xs->len-1; 0<=i; i--) { + MalVal * const elt = g_array_index(xs, MalVal*, i); + if (starts_with(elt, "splice-unquote")) + acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc); + else + acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc); + } + return acc; } MalVal *quasiquote(MalVal *ast) { - if (!is_pair(ast)) { - return _listX(2, malval_new_symbol("quote"), ast); - } else { - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("unquote", a0->val.string) == 0) { + switch (ast->type) { + case MAL_LIST: + if (starts_with(ast, "unquote")) return _nth(ast, 1); - } else if (is_pair(a0)) { - MalVal *a00 = _nth(a0, 0); - if ((a00->type & MAL_SYMBOL) && - strcmp("splice-unquote", a00->val.string) == 0) { - return _listX(3, malval_new_symbol("concat"), - _nth(a0, 1), - quasiquote(_rest(ast))); - } - } - return _listX(3, malval_new_symbol("cons"), - quasiquote(a0), - quasiquote(_rest(ast))); + else + return qq_iter(ast->val.array); + case MAL_VECTOR: + return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array)); + case MAL_HASH_MAP: + case MAL_SYMBOL: + return _listX(2, malval_new_symbol("quote"), ast); + default: + return ast; } } @@ -163,6 +174,9 @@ MalVal *EVAL(MalVal *ast, Env *env) { strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quasiquoteexpand", a0->val.string) == 0) { + return quasiquote(_nth(ast, 1)); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); diff --git a/impls/c/step9_try.c b/impls/c/step9_try.c index 3bfbcb6f..61ac91f7 100644 --- a/impls/c/step9_try.c +++ b/impls/c/step9_try.c @@ -11,6 +11,7 @@ // Declarations MalVal *EVAL(MalVal *ast, Env *env); +MalVal *quasiquote(MalVal *ast); MalVal *macroexpand(MalVal *ast, Env *env); // read @@ -32,30 +33,40 @@ MalVal *READ(char prompt[], char *str) { } // eval -int is_pair(MalVal *x) { - return _sequential_Q(x) && (_count(x) > 0); +int starts_with(MalVal *ast, const char *sym) { + if (ast->type != MAL_LIST) + return 0; + const MalVal * const a0 = _first(ast); + return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string); +} + +MalVal *qq_iter(GArray *xs) { + MalVal *acc = _listX(0); + int i; + for (i=xs->len-1; 0<=i; i--) { + MalVal * const elt = g_array_index(xs, MalVal*, i); + if (starts_with(elt, "splice-unquote")) + acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc); + else + acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc); + } + return acc; } MalVal *quasiquote(MalVal *ast) { - if (!is_pair(ast)) { - return _listX(2, malval_new_symbol("quote"), ast); - } else { - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("unquote", a0->val.string) == 0) { + switch (ast->type) { + case MAL_LIST: + if (starts_with(ast, "unquote")) return _nth(ast, 1); - } else if (is_pair(a0)) { - MalVal *a00 = _nth(a0, 0); - if ((a00->type & MAL_SYMBOL) && - strcmp("splice-unquote", a00->val.string) == 0) { - return _listX(3, malval_new_symbol("concat"), - _nth(a0, 1), - quasiquote(_rest(ast))); - } - } - return _listX(3, malval_new_symbol("cons"), - quasiquote(a0), - quasiquote(_rest(ast))); + else + return qq_iter(ast->val.array); + case MAL_VECTOR: + return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array)); + case MAL_HASH_MAP: + case MAL_SYMBOL: + return _listX(2, malval_new_symbol("quote"), ast); + default: + return ast; } } @@ -164,6 +175,9 @@ MalVal *EVAL(MalVal *ast, Env *env) { strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quasiquoteexpand", a0->val.string) == 0) { + return quasiquote(_nth(ast, 1)); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); diff --git a/impls/c/stepA_mal.c b/impls/c/stepA_mal.c index 41ad4d35..75051170 100644 --- a/impls/c/stepA_mal.c +++ b/impls/c/stepA_mal.c @@ -11,6 +11,7 @@ // Declarations MalVal *EVAL(MalVal *ast, Env *env); +MalVal *quasiquote(MalVal *ast); MalVal *macroexpand(MalVal *ast, Env *env); // read @@ -32,30 +33,40 @@ MalVal *READ(char prompt[], char *str) { } // eval -int is_pair(MalVal *x) { - return _sequential_Q(x) && (_count(x) > 0); +int starts_with(MalVal *ast, const char *sym) { + if (ast->type != MAL_LIST) + return 0; + const MalVal * const a0 = _first(ast); + return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string); +} + +MalVal *qq_iter(GArray *xs) { + MalVal *acc = _listX(0); + int i; + for (i=xs->len-1; 0<=i; i--) { + MalVal * const elt = g_array_index(xs, MalVal*, i); + if (starts_with(elt, "splice-unquote")) + acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc); + else + acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc); + } + return acc; } MalVal *quasiquote(MalVal *ast) { - if (!is_pair(ast)) { - return _listX(2, malval_new_symbol("quote"), ast); - } else { - MalVal *a0 = _nth(ast, 0); - if ((a0->type & MAL_SYMBOL) && - strcmp("unquote", a0->val.string) == 0) { + switch (ast->type) { + case MAL_LIST: + if (starts_with(ast, "unquote")) return _nth(ast, 1); - } else if (is_pair(a0)) { - MalVal *a00 = _nth(a0, 0); - if ((a00->type & MAL_SYMBOL) && - strcmp("splice-unquote", a00->val.string) == 0) { - return _listX(3, malval_new_symbol("concat"), - _nth(a0, 1), - quasiquote(_rest(ast))); - } - } - return _listX(3, malval_new_symbol("cons"), - quasiquote(a0), - quasiquote(_rest(ast))); + else + return qq_iter(ast->val.array); + case MAL_VECTOR: + return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array)); + case MAL_HASH_MAP: + case MAL_SYMBOL: + return _listX(2, malval_new_symbol("quote"), ast); + default: + return ast; } } @@ -164,6 +175,9 @@ MalVal *EVAL(MalVal *ast, Env *env) { strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); + } else if ((a0->type & MAL_SYMBOL) && + strcmp("quasiquoteexpand", a0->val.string) == 0) { + return quasiquote(_nth(ast, 1)); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); diff --git a/impls/chuck/core.ck b/impls/chuck/core.ck index 7f3f21fb..b7c76368 100644 --- a/impls/chuck/core.ck +++ b/impls/chuck/core.ck @@ -10,7 +10,7 @@ public class Core "pr-str", "str", "prn", "println", "read-string", "slurp", "atom", "atom?", "deref", "reset!", "swap!", - "cons", "concat", + "vec", "cons", "concat", "nth", "first", "rest", "throw", "apply", "map", @@ -52,6 +52,7 @@ new MalDeref @=> Core.ns["deref"]; new MalDoReset @=> Core.ns["reset!"]; new MalDoSwap @=> Core.ns["swap!"]; +new MalVec @=> Core.ns["vec"]; new MalCons @=> Core.ns["cons"]; new MalConcat @=> Core.ns["concat"]; diff --git a/impls/chuck/step7_quote.ck b/impls/chuck/step7_quote.ck index 004d5f78..e187006c 100644 --- a/impls/chuck/step7_quote.ck +++ b/impls/chuck/step7_quote.ck @@ -27,50 +27,52 @@ fun MalObject READ(string input) return Reader.read_str(input); } -fun int isPair(MalObject m) +fun int starts_with(MalObject a[], string sym) { - if( (m.type == "list" || m.type == "vector") && - Util.sequenceToMalObjectArray(m).size() > 0 ) - { - return true; - } - else + if (a.size() != 2) { return false; } + a[0] @=> MalObject a0; + return a0.type == "symbol" && (a0$MalSymbol).value() == sym; +} +fun MalList qq_loop(MalObject elt, MalList acc) +{ + if( elt.type == "list" && starts_with ((elt$MalList).value(), "splice-unquote") ) + { + return MalList.create([MalSymbol.create("concat"), (elt$MalList).value()[1], acc]); + } + return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]); +} +fun MalList qq_foldr(MalObject a[]) +{ + MalObject empty[0]; // empty, but typed + MalList.create(empty) @=> MalList acc; + for( a.size() - 1 => int i; 0 <= i; i-- ) + { + qq_loop(a[i], acc) @=> acc; + } + return acc; } - fun MalObject quasiquote(MalObject ast) { - if( !isPair(ast) ) + ast.type => string type; + if (type == "list") { + if (starts_with((ast$MalList).value(), "unquote")) + { + return (ast$MalList).value()[1]; + } + return qq_foldr((ast$MalList).value()); + } + if (type == "vector") + { + return MalList.create([MalSymbol.create("vec"), qq_foldr((ast$MalVector).value())]); + } + if (type == "symbol" || type == "hashmap") { return MalList.create([MalSymbol.create("quote"), ast]); } - - Util.sequenceToMalObjectArray(ast) @=> MalObject a[]; - a[0] @=> MalObject a0; - - if( a0.type == "symbol" && (a0$MalSymbol).value() == "unquote" ) - { - return a[1]; - } - - if( isPair(a0) ) - { - Util.sequenceToMalObjectArray(a0) @=> MalObject a0_[]; - a0_[0] @=> MalObject a0_0; - - if( a0_0.type == "symbol" && (a0_0$MalSymbol).value() == "splice-unquote" ) - { - return MalList.create( - [MalSymbol.create("concat"), a0_[1], - quasiquote(MalList.create(MalObject.slice(a, 1)))]); - } - } - - return MalList.create( - [MalSymbol.create("cons"), quasiquote(a[0]), - quasiquote(MalList.create(MalObject.slice(a, 1)))]); + return ast; } fun MalObject EVAL(MalObject m, Env env) @@ -132,6 +134,10 @@ fun MalObject EVAL(MalObject m, Env env) { return ast[1]; } + else if( a0 == "quasiquoteexpand" ) + { + return quasiquote(ast[1]); + } else if( a0 == "quasiquote" ) { quasiquote(ast[1]) @=> m; diff --git a/impls/chuck/step8_macros.ck b/impls/chuck/step8_macros.ck index 83838764..7925c7b0 100644 --- a/impls/chuck/step8_macros.ck +++ b/impls/chuck/step8_macros.ck @@ -27,50 +27,52 @@ fun MalObject READ(string input) return Reader.read_str(input); } -fun int isPair(MalObject m) +fun int starts_with(MalObject a[], string sym) { - if( (m.type == "list" || m.type == "vector") && - Util.sequenceToMalObjectArray(m).size() > 0 ) - { - return true; - } - else + if (a.size() != 2) { return false; } + a[0] @=> MalObject a0; + return a0.type == "symbol" && (a0$MalSymbol).value() == sym; +} +fun MalList qq_loop(MalObject elt, MalList acc) +{ + if( elt.type == "list" && starts_with ((elt$MalList).value(), "splice-unquote") ) + { + return MalList.create([MalSymbol.create("concat"), (elt$MalList).value()[1], acc]); + } + return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]); +} +fun MalList qq_foldr(MalObject a[]) +{ + MalObject empty[0]; // empty, but typed + MalList.create(empty) @=> MalList acc; + for( a.size() - 1 => int i; 0 <= i; i-- ) + { + qq_loop(a[i], acc) @=> acc; + } + return acc; } - fun MalObject quasiquote(MalObject ast) { - if( !isPair(ast) ) + ast.type => string type; + if (type == "list") { + if (starts_with((ast$MalList).value(), "unquote")) + { + return (ast$MalList).value()[1]; + } + return qq_foldr((ast$MalList).value()); + } + if (type == "vector") + { + return MalList.create([MalSymbol.create("vec"), qq_foldr((ast$MalVector).value())]); + } + if (type == "symbol" || type == "hashmap") { return MalList.create([MalSymbol.create("quote"), ast]); } - - Util.sequenceToMalObjectArray(ast) @=> MalObject a[]; - a[0] @=> MalObject a0; - - if( a0.type == "symbol" && (a0$MalSymbol).value() == "unquote" ) - { - return a[1]; - } - - if( isPair(a0) ) - { - Util.sequenceToMalObjectArray(a0) @=> MalObject a0_[]; - a0_[0] @=> MalObject a0_0; - - if( a0_0.type == "symbol" && (a0_0$MalSymbol).value() == "splice-unquote" ) - { - return MalList.create( - [MalSymbol.create("concat"), a0_[1], - quasiquote(MalList.create(MalObject.slice(a, 1)))]); - } - } - - return MalList.create( - [MalSymbol.create("cons"), quasiquote(a[0]), - quasiquote(MalList.create(MalObject.slice(a, 1)))]); + return ast; } fun int isMacroCall(MalObject ast, Env env) @@ -184,6 +186,10 @@ fun MalObject EVAL(MalObject m, Env env) { return ast[1]; } + else if( a0 == "quasiquoteexpand" ) + { + return quasiquote(ast[1]); + } else if( a0 == "quasiquote" ) { quasiquote(ast[1]) @=> m; diff --git a/impls/chuck/step9_try.ck b/impls/chuck/step9_try.ck index bbc8f4f9..c46c6e94 100644 --- a/impls/chuck/step9_try.ck +++ b/impls/chuck/step9_try.ck @@ -27,50 +27,52 @@ fun MalObject READ(string input) return Reader.read_str(input); } -fun int isPair(MalObject m) +fun int starts_with(MalObject a[], string sym) { - if( (m.type == "list" || m.type == "vector") && - Util.sequenceToMalObjectArray(m).size() > 0 ) - { - return true; - } - else + if (a.size() != 2) { return false; } + a[0] @=> MalObject a0; + return a0.type == "symbol" && (a0$MalSymbol).value() == sym; +} +fun MalList qq_loop(MalObject elt, MalList acc) +{ + if( elt.type == "list" && starts_with ((elt$MalList).value(), "splice-unquote") ) + { + return MalList.create([MalSymbol.create("concat"), (elt$MalList).value()[1], acc]); + } + return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]); +} +fun MalList qq_foldr(MalObject a[]) +{ + MalObject empty[0]; // empty, but typed + MalList.create(empty) @=> MalList acc; + for( a.size() - 1 => int i; 0 <= i; i-- ) + { + qq_loop(a[i], acc) @=> acc; + } + return acc; } - fun MalObject quasiquote(MalObject ast) { - if( !isPair(ast) ) + ast.type => string type; + if (type == "list") { + if (starts_with((ast$MalList).value(), "unquote")) + { + return (ast$MalList).value()[1]; + } + return qq_foldr((ast$MalList).value()); + } + if (type == "vector") + { + return MalList.create([MalSymbol.create("vec"), qq_foldr((ast$MalVector).value())]); + } + if (type == "symbol" || type == "hashmap") { return MalList.create([MalSymbol.create("quote"), ast]); } - - Util.sequenceToMalObjectArray(ast) @=> MalObject a[]; - a[0] @=> MalObject a0; - - if( a0.type == "symbol" && (a0$MalSymbol).value() == "unquote" ) - { - return a[1]; - } - - if( isPair(a0) ) - { - Util.sequenceToMalObjectArray(a0) @=> MalObject a0_[]; - a0_[0] @=> MalObject a0_0; - - if( a0_0.type == "symbol" && (a0_0$MalSymbol).value() == "splice-unquote" ) - { - return MalList.create( - [MalSymbol.create("concat"), a0_[1], - quasiquote(MalList.create(MalObject.slice(a, 1)))]); - } - } - - return MalList.create( - [MalSymbol.create("cons"), quasiquote(a[0]), - quasiquote(MalList.create(MalObject.slice(a, 1)))]); + return ast; } fun int isMacroCall(MalObject ast, Env env) @@ -184,6 +186,10 @@ fun MalObject EVAL(MalObject m, Env env) { return ast[1]; } + else if( a0 == "quasiquoteexpand" ) + { + return quasiquote(ast[1]); + } else if( a0 == "quasiquote" ) { quasiquote(ast[1]) @=> m; diff --git a/impls/chuck/stepA_mal.ck b/impls/chuck/stepA_mal.ck index 154ae65f..303a1669 100644 --- a/impls/chuck/stepA_mal.ck +++ b/impls/chuck/stepA_mal.ck @@ -27,50 +27,52 @@ fun MalObject READ(string input) return Reader.read_str(input); } -fun int isPair(MalObject m) +fun int starts_with(MalObject a[], string sym) { - if( (m.type == "list" || m.type == "vector") && - Util.sequenceToMalObjectArray(m).size() > 0 ) - { - return true; - } - else + if (a.size() != 2) { return false; } + a[0] @=> MalObject a0; + return a0.type == "symbol" && (a0$MalSymbol).value() == sym; +} +fun MalList qq_loop(MalObject elt, MalList acc) +{ + if( elt.type == "list" && starts_with ((elt$MalList).value(), "splice-unquote") ) + { + return MalList.create([MalSymbol.create("concat"), (elt$MalList).value()[1], acc]); + } + return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]); +} +fun MalList qq_foldr(MalObject a[]) +{ + MalObject empty[0]; // empty, but typed + MalList.create(empty) @=> MalList acc; + for( a.size() - 1 => int i; 0 <= i; i-- ) + { + qq_loop(a[i], acc) @=> acc; + } + return acc; } - fun MalObject quasiquote(MalObject ast) { - if( !isPair(ast) ) + ast.type => string type; + if (type == "list") { + if (starts_with((ast$MalList).value(), "unquote")) + { + return (ast$MalList).value()[1]; + } + return qq_foldr((ast$MalList).value()); + } + if (type == "vector") + { + return MalList.create([MalSymbol.create("vec"), qq_foldr((ast$MalVector).value())]); + } + if (type == "symbol" || type == "hashmap") { return MalList.create([MalSymbol.create("quote"), ast]); } - - Util.sequenceToMalObjectArray(ast) @=> MalObject a[]; - a[0] @=> MalObject a0; - - if( a0.type == "symbol" && (a0$MalSymbol).value() == "unquote" ) - { - return a[1]; - } - - if( isPair(a0) ) - { - Util.sequenceToMalObjectArray(a0) @=> MalObject a0_[]; - a0_[0] @=> MalObject a0_0; - - if( a0_0.type == "symbol" && (a0_0$MalSymbol).value() == "splice-unquote" ) - { - return MalList.create( - [MalSymbol.create("concat"), a0_[1], - quasiquote(MalList.create(MalObject.slice(a, 1)))]); - } - } - - return MalList.create( - [MalSymbol.create("cons"), quasiquote(a[0]), - quasiquote(MalList.create(MalObject.slice(a, 1)))]); + return ast; } fun int isMacroCall(MalObject ast, Env env) @@ -184,6 +186,10 @@ fun MalObject EVAL(MalObject m, Env env) { return ast[1]; } + else if( a0 == "quasiquoteexpand" ) + { + return quasiquote(ast[1]); + } else if( a0 == "quasiquote" ) { quasiquote(ast[1]) @=> m; diff --git a/impls/chuck/types/subr/MalVec.ck b/impls/chuck/types/subr/MalVec.ck new file mode 100644 index 00000000..0a535643 --- /dev/null +++ b/impls/chuck/types/subr/MalVec.ck @@ -0,0 +1,15 @@ +public class MalVec extends MalSubr +{ + fun MalObject call(MalObject args[]) + { + if (args.size() == 1) { + args[0] @=> MalObject a0; + if (a0.type == "vector") { + return a0; + } else if (a0.type == "list") { + return MalVector.create((a0$MalList).value()); + } + } + return MalError.create(MalString.create("vec: wrong arguments")); + } +} diff --git a/impls/clojure/src/mal/core.cljc b/impls/clojure/src/mal/core.cljc index 3e023b30..e1df9326 100644 --- a/impls/clojure/src/mal/core.cljc +++ b/impls/clojure/src/mal/core.cljc @@ -72,6 +72,7 @@ ['vals (fn [hm] (let [vs (vals hm)] (if (nil? vs) '() vs)))] ['sequential? sequential?] + ['vec vec] ['cons cons] ['concat #(apply list (apply concat %&))] ['nth nth] diff --git a/impls/clojure/src/mal/step7_quote.cljc b/impls/clojure/src/mal/step7_quote.cljc index 647d559a..5b228415 100644 --- a/impls/clojure/src/mal/step7_quote.cljc +++ b/impls/clojure/src/mal/step7_quote.cljc @@ -13,22 +13,25 @@ ;; eval (declare EVAL) -(defn is-pair [x] - (and (sequential? x) (> (count x) 0))) +(declare quasiquote) +(defn starts_with [ast sym] + (and (seq? ast) + (= (first ast) sym))) +(defn qq-iter [seq] + (if (empty? seq) + () + (let [elt (first seq) + acc (qq-iter (rest seq))] + (if (starts_with elt 'splice-unquote) + (list 'concat (second elt) acc) + (list 'cons (quasiquote elt) acc))))) (defn quasiquote [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (second ast) - - (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) - (list 'concat (-> ast first second) (quasiquote (rest ast))) - - :else - (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) + (cond (starts_with ast 'unquote) (second ast) + (seq? ast) (qq-iter ast) + (vector? ast) (list 'vec (qq-iter ast)) + (or (symbol? ast) (map? ast)) (list 'quote ast) + :else ast)) (defn eval-ast [ast env] (cond @@ -69,6 +72,9 @@ 'quote a1 + 'quasiquoteexpand + (quasiquote a1) + 'quasiquote (recur (quasiquote a1) env) diff --git a/impls/clojure/src/mal/step8_macros.cljc b/impls/clojure/src/mal/step8_macros.cljc index 3949dd11..fea4a395 100644 --- a/impls/clojure/src/mal/step8_macros.cljc +++ b/impls/clojure/src/mal/step8_macros.cljc @@ -14,22 +14,25 @@ ;; eval (declare EVAL) -(defn is-pair [x] - (and (sequential? x) (> (count x) 0))) +(declare quasiquote) +(defn starts_with [ast sym] + (and (seq? ast) + (= (first ast) sym))) +(defn qq-iter [seq] + (if (empty? seq) + () + (let [elt (first seq) + acc (qq-iter (rest seq))] + (if (starts_with elt 'splice-unquote) + (list 'concat (second elt) acc) + (list 'cons (quasiquote elt) acc))))) (defn quasiquote [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (second ast) - - (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) - (list 'concat (-> ast first second) (quasiquote (rest ast))) - - :else - (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) + (cond (starts_with ast 'unquote) (second ast) + (seq? ast) (qq-iter ast) + (vector? ast) (list 'vec (qq-iter ast)) + (or (symbol? ast) (map? ast)) (list 'quote ast) + :else ast)) (defn is-macro-call [ast env] (and (seq? ast) @@ -88,6 +91,9 @@ 'quote a1 + 'quasiquoteexpand + (quasiquote a1) + 'quasiquote (recur (quasiquote a1) env) diff --git a/impls/clojure/src/mal/step9_try.cljc b/impls/clojure/src/mal/step9_try.cljc index 3b8cd044..47a430c8 100644 --- a/impls/clojure/src/mal/step9_try.cljc +++ b/impls/clojure/src/mal/step9_try.cljc @@ -14,22 +14,25 @@ ;; eval (declare EVAL) -(defn is-pair [x] - (and (sequential? x) (> (count x) 0))) +(declare quasiquote) +(defn starts_with [ast sym] + (and (seq? ast) + (= (first ast) sym))) +(defn qq-iter [seq] + (if (empty? seq) + () + (let [elt (first seq) + acc (qq-iter (rest seq))] + (if (starts_with elt 'splice-unquote) + (list 'concat (second elt) acc) + (list 'cons (quasiquote elt) acc))))) (defn quasiquote [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (second ast) - - (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) - (list 'concat (-> ast first second) (quasiquote (rest ast))) - - :else - (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) + (cond (starts_with ast 'unquote) (second ast) + (seq? ast) (qq-iter ast) + (vector? ast) (list 'vec (qq-iter ast)) + (or (symbol? ast) (map? ast)) (list 'quote ast) + :else ast)) (defn is-macro-call [ast env] (and (seq? ast) @@ -88,6 +91,9 @@ 'quote a1 + 'quasiquoteexpand + (quasiquote a1) + 'quasiquote (recur (quasiquote a1) env) diff --git a/impls/clojure/src/mal/stepA_mal.cljc b/impls/clojure/src/mal/stepA_mal.cljc index 8b433e26..d6203ef4 100644 --- a/impls/clojure/src/mal/stepA_mal.cljc +++ b/impls/clojure/src/mal/stepA_mal.cljc @@ -14,22 +14,25 @@ ;; eval (declare EVAL) -(defn is-pair [x] - (and (sequential? x) (> (count x) 0))) +(declare quasiquote) +(defn starts_with [ast sym] + (and (seq? ast) + (= (first ast) sym))) +(defn qq-iter [seq] + (if (empty? seq) + () + (let [elt (first seq) + acc (qq-iter (rest seq))] + (if (starts_with elt 'splice-unquote) + (list 'concat (second elt) acc) + (list 'cons (quasiquote elt) acc))))) (defn quasiquote [ast] - (cond - (not (is-pair ast)) - (list 'quote ast) - - (= 'unquote (first ast)) - (second ast) - - (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast))) - (list 'concat (-> ast first second) (quasiquote (rest ast))) - - :else - (list 'cons (quasiquote (first ast)) (quasiquote (rest ast))))) + (cond (starts_with ast 'unquote) (second ast) + (seq? ast) (qq-iter ast) + (vector? ast) (list 'vec (qq-iter ast)) + (or (symbol? ast) (map? ast)) (list 'quote ast) + :else ast)) (defn is-macro-call [ast env] (and (seq? ast) @@ -88,6 +91,9 @@ 'quote a1 + 'quasiquoteexpand + (quasiquote a1) + 'quasiquote (recur (quasiquote a1) env) diff --git a/impls/coffee/core.coffee b/impls/coffee/core.coffee index 4339beed..555efbaf 100644 --- a/impls/coffee/core.coffee +++ b/impls/coffee/core.coffee @@ -84,6 +84,7 @@ exports.ns = { 'sequential?': types._sequential_Q, 'cons': (a,b) -> [a].concat(b), 'concat': (a=[],b...) -> a.concat(b...), + 'vec': (a) -> types._vector a..., 'nth': (a,b) -> if a.length > b then a[b] else throw new Error "nth: index out of bounds", 'first': (a) -> if a != null and a.length > 0 then a[0] else null, diff --git a/impls/coffee/step7_quote.coffee b/impls/coffee/step7_quote.coffee index 21bf3aa9..9886fdd9 100644 --- a/impls/coffee/step7_quote.coffee +++ b/impls/coffee/step7_quote.coffee @@ -9,15 +9,19 @@ core = require("./core.coffee") READ = (str) -> reader.read_str str # eval -is_pair = (x) -> types._sequential_Q(x) && x.length > 0 +starts_with = (ast, sym) -> + types._list_Q(ast) && 0 + if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator] + else [types._symbol('cons'), quasiquote(elt), accumulator] quasiquote = (ast) -> - if !is_pair(ast) then [types._symbol('quote'), ast] - else if ast[0] != null && ast[0].name == 'unquote' then ast[1] - else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote' - [types._symbol('concat'), ast[0][1], quasiquote(ast[1..])] - else - [types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])] + if starts_with(ast, 'unquote') then ast[1] + else if types._list_Q(ast) then ast.reduceRight(qq_iter, []) + else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])] + else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast] + else ast @@ -51,6 +55,8 @@ EVAL = (ast, env) -> env = let_env when "quote" return a1 + when "quasiquoteexpand" + return quasiquote(a1) when "quasiquote" ast = quasiquote(a1) when "do" diff --git a/impls/coffee/step8_macros.coffee b/impls/coffee/step8_macros.coffee index 1e7dc61e..e6478e6d 100644 --- a/impls/coffee/step8_macros.coffee +++ b/impls/coffee/step8_macros.coffee @@ -9,15 +9,19 @@ core = require("./core.coffee") READ = (str) -> reader.read_str str # eval -is_pair = (x) -> types._sequential_Q(x) && x.length > 0 +starts_with = (ast, sym) -> + types._list_Q(ast) && 0 + if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator] + else [types._symbol('cons'), quasiquote(elt), accumulator] quasiquote = (ast) -> - if !is_pair(ast) then [types._symbol('quote'), ast] - else if ast[0] != null && ast[0].name == 'unquote' then ast[1] - else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote' - [types._symbol('concat'), ast[0][1], quasiquote(ast[1..])] - else - [types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])] + if starts_with(ast, 'unquote') then ast[1] + else if types._list_Q(ast) then ast.reduceRight(qq_iter, []) + else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])] + else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast] + else ast is_macro_call = (ast, env) -> return types._list_Q(ast) && types._symbol_Q(ast[0]) && @@ -63,6 +67,8 @@ EVAL = (ast, env) -> env = let_env when "quote" return a1 + when "quasiquoteexpand" + return quasiquote(a1) when "quasiquote" ast = quasiquote(a1) when "defmacro!" diff --git a/impls/coffee/step9_try.coffee b/impls/coffee/step9_try.coffee index 8cde5126..14aecfa5 100644 --- a/impls/coffee/step9_try.coffee +++ b/impls/coffee/step9_try.coffee @@ -9,15 +9,19 @@ core = require("./core.coffee") READ = (str) -> reader.read_str str # eval -is_pair = (x) -> types._sequential_Q(x) && x.length > 0 +starts_with = (ast, sym) -> + types._list_Q(ast) && 0 + if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator] + else [types._symbol('cons'), quasiquote(elt), accumulator] quasiquote = (ast) -> - if !is_pair(ast) then [types._symbol('quote'), ast] - else if ast[0] != null && ast[0].name == 'unquote' then ast[1] - else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote' - [types._symbol('concat'), ast[0][1], quasiquote(ast[1..])] - else - [types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])] + if starts_with(ast, 'unquote') then ast[1] + else if types._list_Q(ast) then ast.reduceRight(qq_iter, []) + else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])] + else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast] + else ast is_macro_call = (ast, env) -> return types._list_Q(ast) && types._symbol_Q(ast[0]) && @@ -63,6 +67,8 @@ EVAL = (ast, env) -> env = let_env when "quote" return a1 + when "quasiquoteexpand" + return quasiquote(a1) when "quasiquote" ast = quasiquote(a1) when "defmacro!" diff --git a/impls/coffee/stepA_mal.coffee b/impls/coffee/stepA_mal.coffee index 082aa0b9..fde4bf77 100644 --- a/impls/coffee/stepA_mal.coffee +++ b/impls/coffee/stepA_mal.coffee @@ -9,15 +9,19 @@ core = require("./core.coffee") READ = (str) -> reader.read_str str # eval -is_pair = (x) -> types._sequential_Q(x) && x.length > 0 +starts_with = (ast, sym) -> + types._list_Q(ast) && 0 + if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator] + else [types._symbol('cons'), quasiquote(elt), accumulator] quasiquote = (ast) -> - if !is_pair(ast) then [types._symbol('quote'), ast] - else if ast[0] != null && ast[0].name == 'unquote' then ast[1] - else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote' - [types._symbol('concat'), ast[0][1], quasiquote(ast[1..])] - else - [types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])] + if starts_with(ast, 'unquote') then ast[1] + else if types._list_Q(ast) then ast.reduceRight(qq_iter, []) + else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])] + else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast] + else ast is_macro_call = (ast, env) -> return types._list_Q(ast) && types._symbol_Q(ast[0]) && @@ -63,6 +67,8 @@ EVAL = (ast, env) -> env = let_env when "quote" return a1 + when "quasiquoteexpand" + return quasiquote(a1) when "quasiquote" ast = quasiquote(a1) when "defmacro!" diff --git a/impls/common-lisp/src/core.lisp b/impls/common-lisp/src/core.lisp index 74eeb772..74d24fe5 100644 --- a/impls/common-lisp/src/core.lisp +++ b/impls/common-lisp/src/core.lisp @@ -133,6 +133,9 @@ (apply (mal-data-value fn) (append (list (mal-data-value atom)) args)))) +(defmal vec (list) + (make-mal-vector (listify (mal-data-value list)))) + (defmal cons (element list) (make-mal-list (cons element (listify (mal-data-value list))))) diff --git a/impls/common-lisp/src/step7_quote.lisp b/impls/common-lisp/src/step7_quote.lisp index d39cf5a4..f2ee2a27 100644 --- a/impls/common-lisp/src/step7_quote.lisp +++ b/impls/common-lisp/src/step7_quote.lisp @@ -31,8 +31,10 @@ (defvar mal-fn* (make-mal-symbol "fn*")) (defvar mal-quote (make-mal-symbol "quote")) (defvar mal-quasiquote (make-mal-symbol "quasiquote")) +(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand")) (defvar mal-unquote (make-mal-symbol "unquote")) (defvar mal-splice-unquote (make-mal-symbol "splice-unquote")) +(defvar mal-vec (make-mal-symbol "vec")) (defvar mal-cons (make-mal-symbol "cons")) (defvar mal-concat (make-mal-symbol "concat")) @@ -58,29 +60,24 @@ (types:hash-map (eval-hash-map ast env)) (types:any ast))) -(defun is-pair (value) - (and (or (mal-list-p value) - (mal-vector-p value)) - (< 0 (length (mal-data-value value))))) - +(defun qq-reducer (elt acc) + (make-mal-list + (if (and (mal-list-p elt) + (mal-data-value= (first (mal-data-value elt)) mal-splice-unquote)) + (list mal-concat (second (mal-data-value elt)) acc) + (list mal-cons (quasiquote elt) acc)))) +(defun qq-iter (elts) + (reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ()))) (defun quasiquote (ast) - (if (not (is-pair ast)) - (make-mal-list (list mal-quote ast)) - (let ((forms (map 'list #'identity (mal-data-value ast)))) - (cond - ((mal-data-value= mal-unquote (first forms)) - (second forms)) + (switch-mal-type ast + (types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote) + (second (mal-data-value ast)) + (qq-iter (mal-data-value ast)))) + (types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast)))))) + (types:hash-map (make-mal-list (list mal-quote ast))) + (types:symbol (make-mal-list (list mal-quote ast))) + (types:any ast))) - ((and (is-pair (first forms)) - (mal-data-value= mal-splice-unquote - (first (mal-data-value (first forms))))) - (make-mal-list (list mal-concat - (second (mal-data-value (first forms))) - (quasiquote (make-mal-list (cdr forms)))))) - - (t (make-mal-list (list mal-cons - (quasiquote (first forms)) - (quasiquote (make-mal-list (cdr forms)))))))))) (defun mal-read (string) (reader:read-str string)) @@ -96,6 +93,9 @@ ((mal-data-value= mal-quote (first forms)) (return (second forms))) + ((mal-data-value= mal-quasiquoteexpand (first forms)) + (return (quasiquote (second forms)))) + ((mal-data-value= mal-quasiquote (first forms)) (setf ast (quasiquote (second forms)))) diff --git a/impls/common-lisp/src/step8_macros.lisp b/impls/common-lisp/src/step8_macros.lisp index 75149d59..d7fa334a 100644 --- a/impls/common-lisp/src/step8_macros.lisp +++ b/impls/common-lisp/src/step8_macros.lisp @@ -43,8 +43,10 @@ (defvar mal-fn* (make-mal-symbol "fn*")) (defvar mal-quote (make-mal-symbol "quote")) (defvar mal-quasiquote (make-mal-symbol "quasiquote")) +(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand")) (defvar mal-unquote (make-mal-symbol "unquote")) (defvar mal-splice-unquote (make-mal-symbol "splice-unquote")) +(defvar mal-vec (make-mal-symbol "vec")) (defvar mal-cons (make-mal-symbol "cons")) (defvar mal-concat (make-mal-symbol "concat")) (defvar mal-defmacro! (make-mal-symbol "defmacro!")) @@ -72,29 +74,23 @@ (types:hash-map (eval-hash-map ast env)) (types:any ast))) -(defun is-pair (value) - (and (or (mal-list-p value) - (mal-vector-p value)) - (< 0 (length (mal-data-value value))))) - +(defun qq-reducer (elt acc) + (make-mal-list + (if (and (mal-list-p elt) + (mal-data-value= (first (mal-data-value elt)) mal-splice-unquote)) + (list mal-concat (second (mal-data-value elt)) acc) + (list mal-cons (quasiquote elt) acc)))) +(defun qq-iter (elts) + (reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ()))) (defun quasiquote (ast) - (if (not (is-pair ast)) - (make-mal-list (list mal-quote ast)) - (let ((forms (map 'list #'identity (mal-data-value ast)))) - (cond - ((mal-data-value= mal-unquote (first forms)) - (second forms)) - - ((and (is-pair (first forms)) - (mal-data-value= mal-splice-unquote - (first (mal-data-value (first forms))))) - (make-mal-list (list mal-concat - (second (mal-data-value (first forms))) - (quasiquote (make-mal-list (cdr forms)))))) - - (t (make-mal-list (list mal-cons - (quasiquote (first forms)) - (quasiquote (make-mal-list (cdr forms)))))))))) + (switch-mal-type ast + (types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote) + (second (mal-data-value ast)) + (qq-iter (mal-data-value ast)))) + (types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast)))))) + (types:hash-map (make-mal-list (list mal-quote ast))) + (types:symbol (make-mal-list (list mal-quote ast))) + (types:any ast))) (defun is-macro-call (ast env) (when (mal-list-p ast) @@ -129,6 +125,9 @@ ((mal-data-value= mal-quote (first forms)) (return (second forms))) + ((mal-data-value= mal-quasiquoteexpand (first forms)) + (return (quasiquote (second forms)))) + ((mal-data-value= mal-quasiquote (first forms)) (setf ast (quasiquote (second forms)))) diff --git a/impls/common-lisp/src/step9_try.lisp b/impls/common-lisp/src/step9_try.lisp index b05c3614..c3e03629 100644 --- a/impls/common-lisp/src/step9_try.lisp +++ b/impls/common-lisp/src/step9_try.lisp @@ -43,8 +43,10 @@ (defvar mal-fn* (make-mal-symbol "fn*")) (defvar mal-quote (make-mal-symbol "quote")) (defvar mal-quasiquote (make-mal-symbol "quasiquote")) +(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand")) (defvar mal-unquote (make-mal-symbol "unquote")) (defvar mal-splice-unquote (make-mal-symbol "splice-unquote")) +(defvar mal-vec (make-mal-symbol "vec")) (defvar mal-cons (make-mal-symbol "cons")) (defvar mal-concat (make-mal-symbol "concat")) (defvar mal-defmacro! (make-mal-symbol "defmacro!")) @@ -75,29 +77,23 @@ (types:hash-map (eval-hash-map ast env)) (types:any ast))) -(defun is-pair (value) - (and (or (mal-list-p value) - (mal-vector-p value)) - (< 0 (length (mal-data-value value))))) - +(defun qq-reducer (elt acc) + (make-mal-list + (if (and (mal-list-p elt) + (mal-data-value= (first (mal-data-value elt)) mal-splice-unquote)) + (list mal-concat (second (mal-data-value elt)) acc) + (list mal-cons (quasiquote elt) acc)))) +(defun qq-iter (elts) + (reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ()))) (defun quasiquote (ast) - (if (not (is-pair ast)) - (make-mal-list (list mal-quote ast)) - (let ((forms (map 'list #'identity (mal-data-value ast)))) - (cond - ((mal-data-value= mal-unquote (first forms)) - (second forms)) - - ((and (is-pair (first forms)) - (mal-data-value= mal-splice-unquote - (first (mal-data-value (first forms))))) - (make-mal-list (list mal-concat - (second (mal-data-value (first forms))) - (quasiquote (make-mal-list (cdr forms)))))) - - (t (make-mal-list (list mal-cons - (quasiquote (first forms)) - (quasiquote (make-mal-list (cdr forms)))))))))) + (switch-mal-type ast + (types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote) + (second (mal-data-value ast)) + (qq-iter (mal-data-value ast)))) + (types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast)))))) + (types:hash-map (make-mal-list (list mal-quote ast))) + (types:symbol (make-mal-list (list mal-quote ast))) + (types:any ast))) (defun is-macro-call (ast env) (when (mal-list-p ast) @@ -132,6 +128,9 @@ ((mal-data-value= mal-quote (first forms)) (return (second forms))) + ((mal-data-value= mal-quasiquoteexpand (first forms)) + (return (quasiquote (second forms)))) + ((mal-data-value= mal-quasiquote (first forms)) (setf ast (quasiquote (second forms)))) diff --git a/impls/common-lisp/src/stepA_mal.lisp b/impls/common-lisp/src/stepA_mal.lisp index b4873987..9583752b 100644 --- a/impls/common-lisp/src/stepA_mal.lisp +++ b/impls/common-lisp/src/stepA_mal.lisp @@ -42,8 +42,10 @@ (defvar mal-fn* (make-mal-symbol "fn*")) (defvar mal-quote (make-mal-symbol "quote")) (defvar mal-quasiquote (make-mal-symbol "quasiquote")) +(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand")) (defvar mal-unquote (make-mal-symbol "unquote")) (defvar mal-splice-unquote (make-mal-symbol "splice-unquote")) +(defvar mal-vec (make-mal-symbol "vec")) (defvar mal-cons (make-mal-symbol "cons")) (defvar mal-concat (make-mal-symbol "concat")) (defvar mal-defmacro! (make-mal-symbol "defmacro!")) @@ -74,29 +76,23 @@ (types:hash-map (eval-hash-map ast env)) (types:any ast))) -(defun is-pair (value) - (and (or (mal-list-p value) - (mal-vector-p value)) - (< 0 (length (mal-data-value value))))) - +(defun qq-reducer (elt acc) + (make-mal-list + (if (and (mal-list-p elt) + (mal-data-value= (first (mal-data-value elt)) mal-splice-unquote)) + (list mal-concat (second (mal-data-value elt)) acc) + (list mal-cons (quasiquote elt) acc)))) +(defun qq-iter (elts) + (reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ()))) (defun quasiquote (ast) - (if (not (is-pair ast)) - (make-mal-list (list mal-quote ast)) - (let ((forms (map 'list #'identity (mal-data-value ast)))) - (cond - ((mal-data-value= mal-unquote (first forms)) - (second forms)) - - ((and (is-pair (first forms)) - (mal-data-value= mal-splice-unquote - (first (mal-data-value (first forms))))) - (make-mal-list (list mal-concat - (second (mal-data-value (first forms))) - (quasiquote (make-mal-list (cdr forms)))))) - - (t (make-mal-list (list mal-cons - (quasiquote (first forms)) - (quasiquote (make-mal-list (cdr forms)))))))))) + (switch-mal-type ast + (types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote) + (second (mal-data-value ast)) + (qq-iter (mal-data-value ast)))) + (types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast)))))) + (types:hash-map (make-mal-list (list mal-quote ast))) + (types:symbol (make-mal-list (list mal-quote ast))) + (types:any ast))) (defun is-macro-call (ast env) (when (mal-list-p ast) @@ -131,6 +127,9 @@ ((mal-data-value= mal-quote (first forms)) (return (second forms))) + ((mal-data-value= mal-quasiquoteexpand (first forms)) + (return (quasiquote (second forms)))) + ((mal-data-value= mal-quasiquote (first forms)) (setf ast (quasiquote (second forms)))) diff --git a/impls/cpp/Core.cpp b/impls/cpp/Core.cpp index 3c0a8adb..b05895ec 100644 --- a/impls/cpp/Core.cpp +++ b/impls/cpp/Core.cpp @@ -509,6 +509,13 @@ BUILTIN("vals") return hash->values(); } +BUILTIN("vec") +{ + CHECK_ARGS_IS(1); + ARG(malSequence, s); + return mal::vector(s->begin(), s->end()); +} + BUILTIN("vector") { return mal::vector(argsBegin, argsEnd); diff --git a/impls/cpp/step7_quote.cpp b/impls/cpp/step7_quote.cpp index d094c5f7..337353dd 100644 --- a/impls/cpp/step7_quote.cpp +++ b/impls/cpp/step7_quote.cpp @@ -146,6 +146,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) continue; // TCO } + if (special == "quasiquoteexpand") { + checkArgsIs("quasiquote", 1, argCount); + return quasiquote(list->item(1)); + } + if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); @@ -192,44 +197,41 @@ static bool isSymbol(malValuePtr obj, const String& text) return sym && (sym->value() == text); } -static const malSequence* isPair(malValuePtr obj) +// Return arg when ast matches ('sym, arg), else NULL. +static malValuePtr starts_with(const malValuePtr ast, const char* sym) { - const malSequence* list = DYNAMIC_CAST(malSequence, obj); - return list && !list->isEmpty() ? list : NULL; + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || list->isEmpty() || !isSymbol(list->item(0), sym)) + return NULL; + checkArgsIs(sym, 1, list->count() - 1); + return list->item(1); } static malValuePtr quasiquote(malValuePtr obj) { - const malSequence* seq = isPair(obj); - if (!seq) { + if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj)) return mal::list(mal::symbol("quote"), obj); - } - if (isSymbol(seq->item(0), "unquote")) { - // (qq (uq form)) -> form - checkArgsIs("unquote", 1, seq->count() - 1); - return seq->item(1); - } + const malSequence* seq = DYNAMIC_CAST(malSequence, obj); + if (!seq) + return obj; - const malSequence* innerSeq = isPair(seq->item(0)); - if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) { - checkArgsIs("splice-unquote", 1, innerSeq->count() - 1); - // (qq (sq '(a b c))) -> a b c - return mal::list( - mal::symbol("concat"), - innerSeq->item(1), - quasiquote(seq->rest()) - ); - } - else { - // (qq (a b c)) -> (list (qq a) (qq b) (qq c)) - // (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs))) - return mal::list( - mal::symbol("cons"), - quasiquote(seq->first()), - quasiquote(seq->rest()) - ); + const malValuePtr unquoted = starts_with(obj, "unquote"); + if (unquoted) + return unquoted; + + malValuePtr res = mal::list(new malValueVec(0)); + for (int i=seq->count()-1; 0<=i; i--) { + const malValuePtr elt = seq->item(i); + const malValuePtr spl_unq = starts_with(elt, "splice-unquote"); + if (spl_unq) + res = mal::list(mal::symbol("concat"), spl_unq, res); + else + res = mal::list(mal::symbol("cons"), quasiquote(elt), res); } + if (DYNAMIC_CAST(malVector, obj)) + res = mal::list(mal::symbol("vec"), res); + return res; } static const char* malFunctionTable[] = { diff --git a/impls/cpp/step8_macros.cpp b/impls/cpp/step8_macros.cpp index 671dc488..a425fdd2 100644 --- a/impls/cpp/step8_macros.cpp +++ b/impls/cpp/step8_macros.cpp @@ -168,6 +168,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) return macroExpand(list->item(1), env); } + if (special == "quasiquoteexpand") { + checkArgsIs("quasiquote", 1, argCount); + return quasiquote(list->item(1)); + } + if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); @@ -214,50 +219,48 @@ static bool isSymbol(malValuePtr obj, const String& text) return sym && (sym->value() == text); } -static const malSequence* isPair(malValuePtr obj) +// Return arg when ast matches ('sym, arg), else NULL. +static malValuePtr starts_with(const malValuePtr ast, const char* sym) { - const malSequence* list = DYNAMIC_CAST(malSequence, obj); - return list && !list->isEmpty() ? list : NULL; + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || list->isEmpty() || !isSymbol(list->item(0), sym)) + return NULL; + checkArgsIs(sym, 1, list->count() - 1); + return list->item(1); } static malValuePtr quasiquote(malValuePtr obj) { - const malSequence* seq = isPair(obj); - if (!seq) { + if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj)) return mal::list(mal::symbol("quote"), obj); - } - if (isSymbol(seq->item(0), "unquote")) { - // (qq (uq form)) -> form - checkArgsIs("unquote", 1, seq->count() - 1); - return seq->item(1); - } + const malSequence* seq = DYNAMIC_CAST(malSequence, obj); + if (!seq) + return obj; - const malSequence* innerSeq = isPair(seq->item(0)); - if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) { - checkArgsIs("splice-unquote", 1, innerSeq->count() - 1); - // (qq (sq '(a b c))) -> a b c - return mal::list( - mal::symbol("concat"), - innerSeq->item(1), - quasiquote(seq->rest()) - ); - } - else { - // (qq (a b c)) -> (list (qq a) (qq b) (qq c)) - // (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs))) - return mal::list( - mal::symbol("cons"), - quasiquote(seq->first()), - quasiquote(seq->rest()) - ); + const malValuePtr unquoted = starts_with(obj, "unquote"); + if (unquoted) + return unquoted; + + malValuePtr res = mal::list(new malValueVec(0)); + for (int i=seq->count()-1; 0<=i; i--) { + const malValuePtr elt = seq->item(i); + const malValuePtr spl_unq = starts_with(elt, "splice-unquote"); + if (spl_unq) + res = mal::list(mal::symbol("concat"), spl_unq, res); + else + res = mal::list(mal::symbol("cons"), quasiquote(elt), res); } + if (DYNAMIC_CAST(malVector, obj)) + res = mal::list(mal::symbol("vec"), res); + return res; } static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env) { - if (const malSequence* seq = isPair(obj)) { - if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) { + const malList* seq = DYNAMIC_CAST(malList, obj); + if (seq && !seq->isEmpty()) { + if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) { if (malEnvPtr symEnv = env->find(sym->value())) { malValuePtr value = sym->eval(symEnv); if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) { diff --git a/impls/cpp/step9_try.cpp b/impls/cpp/step9_try.cpp index 064f4e27..5b38a846 100644 --- a/impls/cpp/step9_try.cpp +++ b/impls/cpp/step9_try.cpp @@ -171,6 +171,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) return macroExpand(list->item(1), env); } + if (special == "quasiquoteexpand") { + checkArgsIs("quasiquote", 1, argCount); + return quasiquote(list->item(1)); + } + if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); @@ -263,50 +268,48 @@ static bool isSymbol(malValuePtr obj, const String& text) return sym && (sym->value() == text); } -static const malSequence* isPair(malValuePtr obj) +// Return arg when ast matches ('sym, arg), else NULL. +static malValuePtr starts_with(const malValuePtr ast, const char* sym) { - const malSequence* list = DYNAMIC_CAST(malSequence, obj); - return list && !list->isEmpty() ? list : NULL; + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || list->isEmpty() || !isSymbol(list->item(0), sym)) + return NULL; + checkArgsIs(sym, 1, list->count() - 1); + return list->item(1); } static malValuePtr quasiquote(malValuePtr obj) { - const malSequence* seq = isPair(obj); - if (!seq) { + if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj)) return mal::list(mal::symbol("quote"), obj); - } - if (isSymbol(seq->item(0), "unquote")) { - // (qq (uq form)) -> form - checkArgsIs("unquote", 1, seq->count() - 1); - return seq->item(1); - } + const malSequence* seq = DYNAMIC_CAST(malSequence, obj); + if (!seq) + return obj; - const malSequence* innerSeq = isPair(seq->item(0)); - if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) { - checkArgsIs("splice-unquote", 1, innerSeq->count() - 1); - // (qq (sq '(a b c))) -> a b c - return mal::list( - mal::symbol("concat"), - innerSeq->item(1), - quasiquote(seq->rest()) - ); - } - else { - // (qq (a b c)) -> (list (qq a) (qq b) (qq c)) - // (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs))) - return mal::list( - mal::symbol("cons"), - quasiquote(seq->first()), - quasiquote(seq->rest()) - ); + const malValuePtr unquoted = starts_with(obj, "unquote"); + if (unquoted) + return unquoted; + + malValuePtr res = mal::list(new malValueVec(0)); + for (int i=seq->count()-1; 0<=i; i--) { + const malValuePtr elt = seq->item(i); + const malValuePtr spl_unq = starts_with(elt, "splice-unquote"); + if (spl_unq) + res = mal::list(mal::symbol("concat"), spl_unq, res); + else + res = mal::list(mal::symbol("cons"), quasiquote(elt), res); } + if (DYNAMIC_CAST(malVector, obj)) + res = mal::list(mal::symbol("vec"), res); + return res; } static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env) { - if (const malSequence* seq = isPair(obj)) { - if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) { + const malList* seq = DYNAMIC_CAST(malList, obj); + if (seq && !seq->isEmpty()) { + if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) { if (malEnvPtr symEnv = env->find(sym->value())) { malValuePtr value = sym->eval(symEnv); if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) { diff --git a/impls/cpp/stepA_mal.cpp b/impls/cpp/stepA_mal.cpp index 30aa9994..34c940ba 100644 --- a/impls/cpp/stepA_mal.cpp +++ b/impls/cpp/stepA_mal.cpp @@ -172,6 +172,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) return macroExpand(list->item(1), env); } + if (special == "quasiquoteexpand") { + checkArgsIs("quasiquote", 1, argCount); + return quasiquote(list->item(1)); + } + if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); @@ -264,50 +269,48 @@ static bool isSymbol(malValuePtr obj, const String& text) return sym && (sym->value() == text); } -static const malSequence* isPair(malValuePtr obj) +// Return arg when ast matches ('sym, arg), else NULL. +static malValuePtr starts_with(const malValuePtr ast, const char* sym) { - const malSequence* list = DYNAMIC_CAST(malSequence, obj); - return list && !list->isEmpty() ? list : NULL; + const malList* list = DYNAMIC_CAST(malList, ast); + if (!list || list->isEmpty() || !isSymbol(list->item(0), sym)) + return NULL; + checkArgsIs(sym, 1, list->count() - 1); + return list->item(1); } static malValuePtr quasiquote(malValuePtr obj) { - const malSequence* seq = isPair(obj); - if (!seq) { + if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj)) return mal::list(mal::symbol("quote"), obj); - } - if (isSymbol(seq->item(0), "unquote")) { - // (qq (uq form)) -> form - checkArgsIs("unquote", 1, seq->count() - 1); - return seq->item(1); - } + const malSequence* seq = DYNAMIC_CAST(malSequence, obj); + if (!seq) + return obj; - const malSequence* innerSeq = isPair(seq->item(0)); - if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) { - checkArgsIs("splice-unquote", 1, innerSeq->count() - 1); - // (qq (sq '(a b c))) -> a b c - return mal::list( - mal::symbol("concat"), - innerSeq->item(1), - quasiquote(seq->rest()) - ); - } - else { - // (qq (a b c)) -> (list (qq a) (qq b) (qq c)) - // (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs))) - return mal::list( - mal::symbol("cons"), - quasiquote(seq->first()), - quasiquote(seq->rest()) - ); + const malValuePtr unquoted = starts_with(obj, "unquote"); + if (unquoted) + return unquoted; + + malValuePtr res = mal::list(new malValueVec(0)); + for (int i=seq->count()-1; 0<=i; i--) { + const malValuePtr elt = seq->item(i); + const malValuePtr spl_unq = starts_with(elt, "splice-unquote"); + if (spl_unq) + res = mal::list(mal::symbol("concat"), spl_unq, res); + else + res = mal::list(mal::symbol("cons"), quasiquote(elt), res); } + if (DYNAMIC_CAST(malVector, obj)) + res = mal::list(mal::symbol("vec"), res); + return res; } static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env) { - if (const malSequence* seq = isPair(obj)) { - if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) { + const malList* seq = DYNAMIC_CAST(malList, obj); + if (seq && !seq->isEmpty()) { + if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) { if (malEnvPtr symEnv = env->find(sym->value())) { malValuePtr value = sym->eval(symEnv); if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) { diff --git a/impls/crystal/core.cr b/impls/crystal/core.cr index 52b66c89..05c1fade 100644 --- a/impls/crystal/core.cr +++ b/impls/crystal/core.cr @@ -88,6 +88,12 @@ module Mal end end + def self.vec(args) + arg = args.first.unwrap + arg.is_a? Array || eval_error "argument of vec must be a sequence" + arg.to_mal(Mal::Vector) + end + def self.nth(args) a0, a1 = args[0].unwrap, args[1].unwrap eval_error "1st argument of nth must be list or vector" unless a0.is_a? Array @@ -410,6 +416,7 @@ module Mal "slurp" => func(:slurp), "cons" => func(:cons), "concat" => func(:concat), + "vec" => func(:vec), "nth" => func(:nth), "first" => func(:first), "rest" => func(:rest), diff --git a/impls/crystal/step7_quote.cr b/impls/crystal/step7_quote.cr index 4a0618a9..d29f453e 100755 --- a/impls/crystal/step7_quote.cr +++ b/impls/crystal/step7_quote.cr @@ -51,36 +51,49 @@ module Mal read_str str end - macro is_pair(list) - {{list}}.is_a?(Array) && !{{list}}.empty? + def starts_with(list, symbol) + if list.size == 2 + head = list.first.unwrap + head.is_a? Mal::Symbol && head.str == symbol + end + end + + def quasiquote_elts(list) + acc = Mal::Type.new(Mal::List.new) + list.reverse.each do |elt| + elt_val = elt.unwrap + if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote") + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc + ) + else + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc + ) + end + end + acc end def quasiquote(ast) - list = ast.unwrap - - unless is_pair(list) - return Mal::Type.new( + ast_val = ast.unwrap + case ast_val + when Mal::List + if starts_with(ast_val,"unquote") + ast_val[1] + else + quasiquote_elts(ast_val) + end + when Mal::Vector + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val) + ) + when Mal::HashMap, Mal::Symbol + Mal::Type.new ( Mal::List.new << gen_type(Mal::Symbol, "quote") << ast ) - end - - head = list.first.unwrap - - case - # ("unquote" ...) - when head.is_a?(Mal::Symbol) && head.str == "unquote" - list[1] - # (("splice-unquote" ...) ...) - when is_pair(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote" - tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new) { |e, l| l << e } - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail) - ) else - tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new) { |e, l| l << e } - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail) - ) + ast end end @@ -161,6 +174,8 @@ module Mal Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) when "quote" list[1] + when "quasiquoteexpand" + quasiquote list[1] when "quasiquote" ast = quasiquote list[1] next # TCO diff --git a/impls/crystal/step8_macros.cr b/impls/crystal/step8_macros.cr index 1eb219e2..0b102857 100755 --- a/impls/crystal/step8_macros.cr +++ b/impls/crystal/step8_macros.cr @@ -51,36 +51,49 @@ module Mal read_str str end - macro pair?(list) - {{list}}.is_a?(Array) && !{{list}}.empty? + def starts_with(list, symbol) + if list.size == 2 + head = list.first.unwrap + head.is_a? Mal::Symbol && head.str == symbol + end + end + + def quasiquote_elts(list) + acc = Mal::Type.new(Mal::List.new) + list.reverse.each do |elt| + elt_val = elt.unwrap + if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote") + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc + ) + else + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc + ) + end + end + acc end def quasiquote(ast) - list = ast.unwrap - - unless pair?(list) - return Mal::Type.new( + ast_val = ast.unwrap + case ast_val + when Mal::List + if starts_with(ast_val,"unquote") + ast_val[1] + else + quasiquote_elts(ast_val) + end + when Mal::Vector + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val) + ) + when Mal::HashMap, Mal::Symbol + Mal::Type.new ( Mal::List.new << gen_type(Mal::Symbol, "quote") << ast ) - end - - head = list.first.unwrap - - case - # ("unquote" ...) - when head.is_a?(Mal::Symbol) && head.str == "unquote" - list[1] - # (("splice-unquote" ...) ...) - when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote" - tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new) { |e, l| l << e } - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail) - ) else - tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new) { |e, l| l << e } - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail) - ) + ast end end @@ -200,6 +213,8 @@ module Mal Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) when "quote" list[1] + when "quasiquoteexpand" + quasiquote list[1] when "quasiquote" ast = quasiquote list[1] next # TCO diff --git a/impls/crystal/step9_try.cr b/impls/crystal/step9_try.cr index d56f1493..1720e162 100755 --- a/impls/crystal/step9_try.cr +++ b/impls/crystal/step9_try.cr @@ -51,36 +51,49 @@ module Mal read_str str end - macro pair?(list) - {{list}}.is_a?(Array) && !{{list}}.empty? + def starts_with(list, symbol) + if list.size == 2 + head = list.first.unwrap + head.is_a? Mal::Symbol && head.str == symbol + end + end + + def quasiquote_elts(list) + acc = Mal::Type.new(Mal::List.new) + list.reverse.each do |elt| + elt_val = elt.unwrap + if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote") + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc + ) + else + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc + ) + end + end + acc end def quasiquote(ast) - list = ast.unwrap - - unless pair?(list) - return Mal::Type.new( + ast_val = ast.unwrap + case ast_val + when Mal::List + if starts_with(ast_val,"unquote") + ast_val[1] + else + quasiquote_elts(ast_val) + end + when Mal::Vector + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val) + ) + when Mal::HashMap, Mal::Symbol + Mal::Type.new ( Mal::List.new << gen_type(Mal::Symbol, "quote") << ast ) - end - - head = list.first.unwrap - - case - # ("unquote" ...) - when head.is_a?(Mal::Symbol) && head.str == "unquote" - list[1] - # (("splice-unquote" ...) ...) - when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote" - tail = Mal::Type.new list[1..-1].to_mal - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail) - ) else - tail = Mal::Type.new list[1..-1].to_mal - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail) - ) + ast end end @@ -200,6 +213,8 @@ module Mal Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) when "quote" list[1] + when "quasiquoteexpand" + quasiquote list[1] when "quasiquote" ast = quasiquote list[1] next # TCO diff --git a/impls/crystal/stepA_mal.cr b/impls/crystal/stepA_mal.cr index eb0aa790..3f662f53 100755 --- a/impls/crystal/stepA_mal.cr +++ b/impls/crystal/stepA_mal.cr @@ -52,36 +52,49 @@ module Mal read_str str end - macro pair?(list) - {{list}}.is_a?(Array) && !{{list}}.empty? + def starts_with(list, symbol) + if list.size == 2 + head = list.first.unwrap + head.is_a? Mal::Symbol && head.str == symbol + end + end + + def quasiquote_elts(list) + acc = Mal::Type.new(Mal::List.new) + list.reverse.each do |elt| + elt_val = elt.unwrap + if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote") + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc + ) + else + acc = Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc + ) + end + end + acc end def quasiquote(ast) - list = ast.unwrap - - unless pair?(list) - return Mal::Type.new( + ast_val = ast.unwrap + case ast_val + when Mal::List + if starts_with(ast_val,"unquote") + ast_val[1] + else + quasiquote_elts(ast_val) + end + when Mal::Vector + Mal::Type.new( + Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val) + ) + when Mal::HashMap, Mal::Symbol + Mal::Type.new ( Mal::List.new << gen_type(Mal::Symbol, "quote") << ast ) - end - - head = list.first.unwrap - - case - # ("unquote" ...) - when head.is_a?(Mal::Symbol) && head.str == "unquote" - list[1] - # (("splice-unquote" ...) ...) - when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote" - tail = Mal::Type.new list[1..-1].to_mal - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail) - ) else - tail = Mal::Type.new list[1..-1].to_mal - Mal::Type.new( - Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail) - ) + ast end end @@ -206,6 +219,8 @@ module Mal Mal::Closure.new(list[2], params, env, func_of(env, params, list[2])) when "quote" list[1] + when "quasiquoteexpand" + quasiquote list[1] when "quasiquote" ast = quasiquote list[1] next # TCO diff --git a/impls/cs/core.cs b/impls/cs/core.cs index 9bb7a7ab..16eb0564 100644 --- a/impls/cs/core.cs +++ b/impls/cs/core.cs @@ -371,6 +371,7 @@ namespace Mal { {"sequential?", sequential_Q}, {"cons", cons}, {"concat", concat}, + {"vec", new MalFunc(a => new MalVector(((MalList)a[0]).getValue()))}, {"nth", nth}, {"first", first}, {"rest", rest}, diff --git a/impls/cs/step7_quote.cs b/impls/cs/step7_quote.cs index 4131c487..6ed7b233 100644 --- a/impls/cs/step7_quote.cs +++ b/impls/cs/step7_quote.cs @@ -21,30 +21,41 @@ namespace Mal { } // eval - public static bool is_pair(MalVal x) { - return x is MalList && ((MalList)x).size() > 0; + public static bool starts_with(MalVal ast, string sym) { + if (ast is MalList && !(ast is MalVector)) { + MalList list = (MalList)ast; + if (list.size() == 2 && list[0] is MalSymbol) { + MalSymbol a0 = (MalSymbol)list[0]; + return a0.getName() == sym; + } + } + return false; } + public static MalVal qq_loop(MalList ast) { + MalVal acc = new MalList(); + for(int i=ast.size()-1; 0<=i; i-=1) { + MalVal elt = ast[i]; + if (starts_with(elt, "splice-unquote")) { + acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc); + } else { + acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc); + } + } + return acc; + } public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { + // Check Vector subclass before List. + if (ast is MalVector) { + return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast))); + } else if (starts_with(ast, "unquote")) { + return ((MalList)ast)[1]; + } else if (ast is MalList) { + return qq_loop((MalList)ast); + } else if (ast is MalSymbol || ast is MalHashMap) { return new MalList(new MalSymbol("quote"), ast); } else { - MalVal a0 = ((MalList)ast)[0]; - if ((a0 is MalSymbol) && - (((MalSymbol)a0).getName() == "unquote")) { - return ((MalList)ast)[1]; - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0)[0]; - if ((a00 is MalSymbol) && - (((MalSymbol)a00).getName() == "splice-unquote")) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0)[1], - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); + return ast; } } @@ -113,6 +124,8 @@ namespace Mal { break; case "quote": return ast[1]; + case "quasiquoteexpand": + return quasiquote(ast[1]); case "quasiquote": orig_ast = quasiquote(ast[1]); break; diff --git a/impls/cs/step8_macros.cs b/impls/cs/step8_macros.cs index d4e2c6bf..9e111dd6 100644 --- a/impls/cs/step8_macros.cs +++ b/impls/cs/step8_macros.cs @@ -21,30 +21,41 @@ namespace Mal { } // eval - public static bool is_pair(MalVal x) { - return x is MalList && ((MalList)x).size() > 0; + public static bool starts_with(MalVal ast, string sym) { + if (ast is MalList && !(ast is MalVector)) { + MalList list = (MalList)ast; + if (list.size() == 2 && list[0] is MalSymbol) { + MalSymbol a0 = (MalSymbol)list[0]; + return a0.getName() == sym; + } + } + return false; } + public static MalVal qq_loop(MalList ast) { + MalVal acc = new MalList(); + for(int i=ast.size()-1; 0<=i; i-=1) { + MalVal elt = ast[i]; + if (starts_with(elt, "splice-unquote")) { + acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc); + } else { + acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc); + } + } + return acc; + } public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { + // Check Vector subclass before List. + if (ast is MalVector) { + return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast))); + } else if (starts_with(ast, "unquote")) { + return ((MalList)ast)[1]; + } else if (ast is MalList) { + return qq_loop((MalList)ast); + } else if (ast is MalSymbol || ast is MalHashMap) { return new MalList(new MalSymbol("quote"), ast); } else { - MalVal a0 = ((MalList)ast)[0]; - if ((a0 is MalSymbol) && - (((MalSymbol)a0).getName() == "unquote")) { - return ((MalList)ast)[1]; - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0)[0]; - if ((a00 is MalSymbol) && - (((MalSymbol)a00).getName() == "splice-unquote")) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0)[1], - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); + return ast; } } @@ -142,6 +153,8 @@ namespace Mal { break; case "quote": return ast[1]; + case "quasiquoteexpand": + return quasiquote(ast[1]); case "quasiquote": orig_ast = quasiquote(ast[1]); break; diff --git a/impls/cs/step9_try.cs b/impls/cs/step9_try.cs index 1f73c552..ba7b6dc9 100644 --- a/impls/cs/step9_try.cs +++ b/impls/cs/step9_try.cs @@ -21,30 +21,41 @@ namespace Mal { } // eval - public static bool is_pair(MalVal x) { - return x is MalList && ((MalList)x).size() > 0; + public static bool starts_with(MalVal ast, string sym) { + if (ast is MalList && !(ast is MalVector)) { + MalList list = (MalList)ast; + if (list.size() == 2 && list[0] is MalSymbol) { + MalSymbol a0 = (MalSymbol)list[0]; + return a0.getName() == sym; + } + } + return false; } + public static MalVal qq_loop(MalList ast) { + MalVal acc = new MalList(); + for(int i=ast.size()-1; 0<=i; i-=1) { + MalVal elt = ast[i]; + if (starts_with(elt, "splice-unquote")) { + acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc); + } else { + acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc); + } + } + return acc; + } public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { + // Check Vector subclass before List. + if (ast is MalVector) { + return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast))); + } else if (starts_with(ast, "unquote")) { + return ((MalList)ast)[1]; + } else if (ast is MalList) { + return qq_loop((MalList)ast); + } else if (ast is MalSymbol || ast is MalHashMap) { return new MalList(new MalSymbol("quote"), ast); } else { - MalVal a0 = ((MalList)ast)[0]; - if ((a0 is MalSymbol) && - (((MalSymbol)a0).getName() == "unquote")) { - return ((MalList)ast)[1]; - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0)[0]; - if ((a00 is MalSymbol) && - (((MalSymbol)a00).getName() == "splice-unquote")) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0)[1], - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); + return ast; } } @@ -142,6 +153,8 @@ namespace Mal { break; case "quote": return ast[1]; + case "quasiquoteexpand": + return quasiquote(ast[1]); case "quasiquote": orig_ast = quasiquote(ast[1]); break; diff --git a/impls/cs/stepA_mal.cs b/impls/cs/stepA_mal.cs index 1d0ab4e9..56f3da09 100644 --- a/impls/cs/stepA_mal.cs +++ b/impls/cs/stepA_mal.cs @@ -21,30 +21,41 @@ namespace Mal { } // eval - public static bool is_pair(MalVal x) { - return x is MalList && ((MalList)x).size() > 0; + public static bool starts_with(MalVal ast, string sym) { + if (ast is MalList && !(ast is MalVector)) { + MalList list = (MalList)ast; + if (list.size() == 2 && list[0] is MalSymbol) { + MalSymbol a0 = (MalSymbol)list[0]; + return a0.getName() == sym; + } + } + return false; } + public static MalVal qq_loop(MalList ast) { + MalVal acc = new MalList(); + for(int i=ast.size()-1; 0<=i; i-=1) { + MalVal elt = ast[i]; + if (starts_with(elt, "splice-unquote")) { + acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc); + } else { + acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc); + } + } + return acc; + } public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { + // Check Vector subclass before List. + if (ast is MalVector) { + return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast))); + } else if (starts_with(ast, "unquote")) { + return ((MalList)ast)[1]; + } else if (ast is MalList) { + return qq_loop((MalList)ast); + } else if (ast is MalSymbol || ast is MalHashMap) { return new MalList(new MalSymbol("quote"), ast); } else { - MalVal a0 = ((MalList)ast)[0]; - if ((a0 is MalSymbol) && - (((MalSymbol)a0).getName() == "unquote")) { - return ((MalList)ast)[1]; - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0)[0]; - if ((a00 is MalSymbol) && - (((MalSymbol)a00).getName() == "splice-unquote")) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0)[1], - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); + return ast; } } @@ -142,6 +153,8 @@ namespace Mal { break; case "quote": return ast[1]; + case "quasiquoteexpand": + return quasiquote(ast[1]); case "quasiquote": orig_ast = quasiquote(ast[1]); break; diff --git a/impls/d/mal_core.d b/impls/d/mal_core.d index 0f27d0da..77734637 100644 --- a/impls/d/mal_core.d +++ b/impls/d/mal_core.d @@ -213,6 +213,12 @@ static MalType mal_concat(MalType[] a ...) return new MalList(res); } +static MalType mal_vec(MalType[] a ...) +{ + verify_args_count(a, 1); + return new MalVector(verify_cast!MalSequential(a[0]).elements); +} + static MalType mal_nth(MalType[] a ...) { verify_args_count(a, 2); @@ -397,6 +403,7 @@ static this() "sequential?": (a ...) => mal_type_q!MalSequential(a), "cons": &mal_cons, "concat": &mal_concat, + "vec": &mal_vec, "nth": &mal_nth, "first": &mal_first, "rest": &mal_rest, diff --git a/impls/d/step7_quote.d b/impls/d/step7_quote.d index 6917fc45..5b3e13af 100644 --- a/impls/d/step7_quote.d +++ b/impls/d/step7_quote.d @@ -13,36 +13,36 @@ import reader; import printer; import types; -bool is_pair(MalType ast) +bool starts_with(MalType ast, MalSymbol sym) { - auto lst = cast(MalSequential) ast; + auto lst = cast(MalList) ast; if (lst is null) return false; - return lst.elements.length > 0; + auto lste = lst.elements; + return lste.length > 0 && lste[0] == sym; } MalType quasiquote(MalType ast) { - if (!is_pair(ast)) - { + if (cast(MalSymbol)ast || cast(MalHashmap)ast) return new MalList([sym_quote, ast]); - } - auto ast_seq = verify_cast!MalSequential(ast); + + auto ast_seq = cast(MalSequential) ast; + if (ast_seq is null) + return ast; + auto aste = ast_seq.elements; - if (aste[0] == sym_unquote) - { + if (starts_with(ast, sym_unquote)) return aste[1]; - } - if (is_pair(aste[0])) - { - auto ast0_seq = verify_cast!MalSequential(aste[0]); - if (ast0_seq.elements[0] == sym_splice_unquote) - { - return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]); - } - } - - return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]); + MalType res = new MalList([]);; + foreach_reverse (elt; ast_seq.elements) + if (starts_with(elt, sym_splice_unquote)) + res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]); + else + res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]); + if (cast(MalVector) ast) + res = new MalList([new MalSymbol("vec"), res]); + return res; } MalType READ(string str) @@ -120,6 +120,9 @@ MalType EVAL(MalType ast, Env env) case "quote": return aste[1]; + case "quasiquoteexpand": + return quasiquote(aste[1]); + case "quasiquote": ast = quasiquote(aste[1]); continue; // TCO diff --git a/impls/d/step8_macros.d b/impls/d/step8_macros.d index 01e9432a..7671d6f8 100644 --- a/impls/d/step8_macros.d +++ b/impls/d/step8_macros.d @@ -13,36 +13,36 @@ import reader; import printer; import types; -bool is_pair(MalType ast) +bool starts_with(MalType ast, MalSymbol sym) { - auto lst = cast(MalSequential) ast; + auto lst = cast(MalList) ast; if (lst is null) return false; - return lst.elements.length > 0; + auto lste = lst.elements; + return lste.length > 0 && lste[0] == sym; } MalType quasiquote(MalType ast) { - if (!is_pair(ast)) - { + if (cast(MalSymbol)ast || cast(MalHashmap)ast) return new MalList([sym_quote, ast]); - } - auto ast_seq = verify_cast!MalSequential(ast); + + auto ast_seq = cast(MalSequential) ast; + if (ast_seq is null) + return ast; + auto aste = ast_seq.elements; - if (aste[0] == sym_unquote) - { + if (starts_with(ast, sym_unquote)) return aste[1]; - } - if (is_pair(aste[0])) - { - auto ast0_seq = verify_cast!MalSequential(aste[0]); - if (ast0_seq.elements[0] == sym_splice_unquote) - { - return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]); - } - } - - return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]); + MalType res = new MalList([]);; + foreach_reverse (elt; ast_seq.elements) + if (starts_with(elt, sym_splice_unquote)) + res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]); + else + res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]); + if (cast(MalVector) ast) + res = new MalList([new MalSymbol("vec"), res]); + return res; } bool is_macro_call(MalType ast, Env env) @@ -155,6 +155,9 @@ MalType EVAL(MalType ast, Env env) case "quote": return aste[1]; + case "quasiquoteexpand": + return quasiquote(aste[1]); + case "quasiquote": ast = quasiquote(aste[1]); continue; // TCO diff --git a/impls/d/step9_try.d b/impls/d/step9_try.d index d06a0a4b..cd44bf27 100644 --- a/impls/d/step9_try.d +++ b/impls/d/step9_try.d @@ -13,36 +13,36 @@ import reader; import printer; import types; -bool is_pair(MalType ast) +bool starts_with(MalType ast, MalSymbol sym) { - auto lst = cast(MalSequential) ast; + auto lst = cast(MalList) ast; if (lst is null) return false; - return lst.elements.length > 0; + auto lste = lst.elements; + return lste.length > 0 && lste[0] == sym; } MalType quasiquote(MalType ast) { - if (!is_pair(ast)) - { + if (cast(MalSymbol)ast || cast(MalHashmap)ast) return new MalList([sym_quote, ast]); - } - auto ast_seq = verify_cast!MalSequential(ast); + + auto ast_seq = cast(MalSequential) ast; + if (ast_seq is null) + return ast; + auto aste = ast_seq.elements; - if (aste[0] == sym_unquote) - { + if (starts_with(ast, sym_unquote)) return aste[1]; - } - if (is_pair(aste[0])) - { - auto ast0_seq = verify_cast!MalSequential(aste[0]); - if (ast0_seq.elements[0] == sym_splice_unquote) - { - return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]); - } - } - - return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]); + MalType res = new MalList([]);; + foreach_reverse (elt; ast_seq.elements) + if (starts_with(elt, sym_splice_unquote)) + res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]); + else + res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]); + if (cast(MalVector) ast) + res = new MalList([new MalSymbol("vec"), res]); + return res; } bool is_macro_call(MalType ast, Env env) @@ -155,6 +155,9 @@ MalType EVAL(MalType ast, Env env) case "quote": return aste[1]; + case "quasiquoteexpand": + return quasiquote(aste[1]); + case "quasiquote": ast = quasiquote(aste[1]); continue; // TCO diff --git a/impls/d/stepA_mal.d b/impls/d/stepA_mal.d index eddf2feb..9fdd0f5d 100644 --- a/impls/d/stepA_mal.d +++ b/impls/d/stepA_mal.d @@ -14,36 +14,36 @@ import reader; import printer; import types; -bool is_pair(MalType ast) +bool starts_with(MalType ast, MalSymbol sym) { - auto lst = cast(MalSequential) ast; + auto lst = cast(MalList) ast; if (lst is null) return false; - return lst.elements.length > 0; + auto lste = lst.elements; + return lste.length > 0 && lste[0] == sym; } MalType quasiquote(MalType ast) { - if (!is_pair(ast)) - { + if (cast(MalSymbol)ast || cast(MalHashmap)ast) return new MalList([sym_quote, ast]); - } - auto ast_seq = verify_cast!MalSequential(ast); + + auto ast_seq = cast(MalSequential) ast; + if (ast_seq is null) + return ast; + auto aste = ast_seq.elements; - if (aste[0] == sym_unquote) - { + if (starts_with(ast, sym_unquote)) return aste[1]; - } - if (is_pair(aste[0])) - { - auto ast0_seq = verify_cast!MalSequential(aste[0]); - if (ast0_seq.elements[0] == sym_splice_unquote) - { - return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]); - } - } - - return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]); + MalType res = new MalList([]);; + foreach_reverse (elt; ast_seq.elements) + if (starts_with(elt, sym_splice_unquote)) + res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]); + else + res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]); + if (cast(MalVector) ast) + res = new MalList([new MalSymbol("vec"), res]); + return res; } bool is_macro_call(MalType ast, Env env) @@ -156,6 +156,9 @@ MalType EVAL(MalType ast, Env env) case "quote": return aste[1]; + case "quasiquoteexpand": + return quasiquote(aste[1]); + case "quasiquote": ast = quasiquote(aste[1]); continue; // TCO diff --git a/impls/dart/core.dart b/impls/dart/core.dart index 047ed82c..a8ac4b89 100644 --- a/impls/dart/core.dart +++ b/impls/dart/core.dart @@ -125,6 +125,13 @@ Map ns = { } return new MalList(results); }), + new MalSymbol('vec'): new MalBuiltin((List args) { + if (args.length == 1) { + if (args[0] is MalVector) return args[0]; + if (args[0] is MalList) return new MalVector(args[0].elements); + } + throw new MalException(new MalString("vec: wrong arguments")); + }), new MalSymbol('nth'): new MalBuiltin((List args) { var indexable = args[0] as MalIterable; var index = args[1] as MalInt; diff --git a/impls/dart/step7_quote.dart b/impls/dart/step7_quote.dart index f32a4900..c8fd399c 100644 --- a/impls/dart/step7_quote.dart +++ b/impls/dart/step7_quote.dart @@ -23,31 +23,33 @@ void setupEnv(List argv) { "(fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); } -MalType quasiquote(MalType ast) { - bool isPair(MalType ast) { - return ast is MalIterable && ast.isNotEmpty; - } +bool starts_with(MalType ast, String sym) { + return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); +} - if (!isPair(ast)) { +MalType qq_loop(List xs) { + var acc = new MalList([]); + for (var i=xs.length-1; 0<=i; i-=1) { + if (starts_with(xs[i], "splice-unquote")) { + acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]); + } else { + acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]); + } + } + return acc; +} + +MalType quasiquote(MalType ast) { + if (starts_with(ast, "unquote")) { + return (ast as MalList).elements[1]; + } else if (ast is MalList) { + return qq_loop(ast.elements); + } else if (ast is MalVector) { + return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]); + } else if (ast is MalSymbol || ast is MalHashMap) { return new MalList([new MalSymbol("quote"), ast]); } else { - var list = ast as MalIterable; - if (list.first == new MalSymbol("unquote")) { - return list[1]; - } else if (isPair(list.first) && - (list.first as MalIterable).first == new MalSymbol("splice-unquote")) { - return new MalList([ - new MalSymbol("concat"), - (list.first as MalIterable)[1], - quasiquote(new MalList(list.sublist(1))) - ]); - } else { - return new MalList([ - new MalSymbol("cons"), - quasiquote(list[0]), - quasiquote(new MalList(list.sublist(1))) - ]); - } + return ast; } } @@ -142,6 +144,8 @@ MalType EVAL(MalType ast, Env env) { EVAL(args[1], new Env(env, params, funcArgs))); } else if (symbol.value == "quote") { return args.single; + } else if (symbol.value == "quasiquoteexpand") { + return quasiquote(args.first); } else if (symbol.value == "quasiquote") { ast = quasiquote(args.first); continue; diff --git a/impls/dart/step8_macros.dart b/impls/dart/step8_macros.dart index ba712cc2..20a564a1 100644 --- a/impls/dart/step8_macros.dart +++ b/impls/dart/step8_macros.dart @@ -58,31 +58,33 @@ MalType macroexpand(MalType ast, Env env) { return ast; } -MalType quasiquote(MalType ast) { - bool isPair(MalType ast) { - return ast is MalIterable && ast.isNotEmpty; - } +bool starts_with(MalType ast, String sym) { + return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); +} - if (!isPair(ast)) { +MalType qq_loop(List xs) { + var acc = new MalList([]); + for (var i=xs.length-1; 0<=i; i-=1) { + if (starts_with(xs[i], "splice-unquote")) { + acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]); + } else { + acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]); + } + } + return acc; +} + +MalType quasiquote(MalType ast) { + if (starts_with(ast, "unquote")) { + return (ast as MalList).elements[1]; + } else if (ast is MalList) { + return qq_loop(ast.elements); + } else if (ast is MalVector) { + return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]); + } else if (ast is MalSymbol || ast is MalHashMap) { return new MalList([new MalSymbol("quote"), ast]); } else { - var list = ast as MalIterable; - if (list.first == new MalSymbol("unquote")) { - return list[1]; - } else if (isPair(list.first) && - (list.first as MalIterable).first == new MalSymbol("splice-unquote")) { - return new MalList([ - new MalSymbol("concat"), - (list.first as MalIterable)[1], - quasiquote(new MalList(list.sublist(1))) - ]); - } else { - return new MalList([ - new MalSymbol("cons"), - quasiquote(list[0]), - quasiquote(new MalList(list.sublist(1))) - ]); - } + return ast; } } @@ -184,6 +186,8 @@ MalType EVAL(MalType ast, Env env) { EVAL(args[1], new Env(env, params, funcArgs))); } else if (symbol.value == "quote") { return args.single; + } else if (symbol.value == "quasiquoteexpand") { + return quasiquote(args.first); } else if (symbol.value == "quasiquote") { ast = quasiquote(args.first); continue; diff --git a/impls/dart/step9_try.dart b/impls/dart/step9_try.dart index 63db07f0..5bd894bc 100644 --- a/impls/dart/step9_try.dart +++ b/impls/dart/step9_try.dart @@ -58,31 +58,33 @@ MalType macroexpand(MalType ast, Env env) { return ast; } -MalType quasiquote(MalType ast) { - bool isPair(MalType ast) { - return ast is MalIterable && ast.isNotEmpty; - } +bool starts_with(MalType ast, String sym) { + return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); +} - if (!isPair(ast)) { +MalType qq_loop(List xs) { + var acc = new MalList([]); + for (var i=xs.length-1; 0<=i; i-=1) { + if (starts_with(xs[i], "splice-unquote")) { + acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]); + } else { + acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]); + } + } + return acc; +} + +MalType quasiquote(MalType ast) { + if (starts_with(ast, "unquote")) { + return (ast as MalList).elements[1]; + } else if (ast is MalList) { + return qq_loop(ast.elements); + } else if (ast is MalVector) { + return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]); + } else if (ast is MalSymbol || ast is MalHashMap) { return new MalList([new MalSymbol("quote"), ast]); } else { - var list = ast as MalIterable; - if (list.first == new MalSymbol("unquote")) { - return list[1]; - } else if (isPair(list.first) && - (list.first as MalIterable).first == new MalSymbol("splice-unquote")) { - return new MalList([ - new MalSymbol("concat"), - (list.first as MalIterable)[1], - quasiquote(new MalList(list.sublist(1))) - ]); - } else { - return new MalList([ - new MalSymbol("cons"), - quasiquote(list[0]), - quasiquote(new MalList(list.sublist(1))) - ]); - } + return ast; } } @@ -184,6 +186,8 @@ MalType EVAL(MalType ast, Env env) { EVAL(args[1], new Env(env, params, funcArgs))); } else if (symbol.value == "quote") { return args.single; + } else if (symbol.value == "quasiquoteexpand") { + return quasiquote(args.first); } else if (symbol.value == "quasiquote") { ast = quasiquote(args.first); continue; diff --git a/impls/dart/stepA_mal.dart b/impls/dart/stepA_mal.dart index d1533665..72bc2015 100644 --- a/impls/dart/stepA_mal.dart +++ b/impls/dart/stepA_mal.dart @@ -60,31 +60,33 @@ MalType macroexpand(MalType ast, Env env) { return ast; } -MalType quasiquote(MalType ast) { - bool isPair(MalType ast) { - return ast is MalIterable && ast.isNotEmpty; - } +bool starts_with(MalType ast, String sym) { + return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); +} - if (!isPair(ast)) { +MalType qq_loop(List xs) { + var acc = new MalList([]); + for (var i=xs.length-1; 0<=i; i-=1) { + if (starts_with(xs[i], "splice-unquote")) { + acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]); + } else { + acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]); + } + } + return acc; +} + +MalType quasiquote(MalType ast) { + if (starts_with(ast, "unquote")) { + return (ast as MalList).elements[1]; + } else if (ast is MalList) { + return qq_loop(ast.elements); + } else if (ast is MalVector) { + return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]); + } else if (ast is MalSymbol || ast is MalHashMap) { return new MalList([new MalSymbol("quote"), ast]); } else { - var list = ast as MalIterable; - if (list.first == new MalSymbol("unquote")) { - return list[1]; - } else if (isPair(list.first) && - (list.first as MalIterable).first == new MalSymbol("splice-unquote")) { - return new MalList([ - new MalSymbol("concat"), - (list.first as MalIterable)[1], - quasiquote(new MalList(list.sublist(1))) - ]); - } else { - return new MalList([ - new MalSymbol("cons"), - quasiquote(list[0]), - quasiquote(new MalList(list.sublist(1))) - ]); - } + return ast; } } @@ -186,6 +188,8 @@ MalType EVAL(MalType ast, Env env) { EVAL(args[1], new Env(env, params, funcArgs))); } else if (symbol.value == "quote") { return args.single; + } else if (symbol.value == "quasiquoteexpand") { + return quasiquote(args.first); } else if (symbol.value == "quasiquote") { ast = quasiquote(args.first); continue; diff --git a/impls/elisp/mal/core.el b/impls/elisp/mal/core.el index 76b6149d..f079bc40 100644 --- a/impls/elisp/mal/core.el +++ b/impls/elisp/mal/core.el @@ -1,79 +1,52 @@ +(require 'cl-lib) + (defun mal-seq-p (mal-object) - (let ((type (mal-type mal-object))) - (if (or (eq type 'list) (eq type 'vector)) - mal-true - mal-false))) + (memq (mal-type mal-object) '(list vector))) (defun mal-listify (mal-object) - (let ((type (mal-type mal-object))) - (if (eq type 'vector) - (append (mal-value mal-object) nil) - (mal-value mal-object)))) + (cl-ecase (mal-type mal-object) + (list (mal-value mal-object)) + (vector (append (mal-value mal-object) nil)))) (defun mal-= (a b) - (let ((a-type (mal-type a)) - (b-type (mal-type b))) - (cond - ((and (and (not (eq a-type 'map)) - (not (eq a-type 'list)) - (not (eq a-type 'vector))) - (and (not (eq b-type 'map)) - (not (eq b-type 'list)) - (not (eq b-type 'vector)))) - (mal-atom-= a b)) - ((and (or (eq a-type 'list) (eq a-type 'vector)) - (or (eq b-type 'list) (eq b-type 'vector))) - (mal-seq-= a b)) - ((and (eq a-type 'map) (eq b-type 'map)) - (mal-map-= a b)) - (t - ;; incompatible types - nil)))) - -(defun mal-atom-= (a b) - (equal (mal-value a) (mal-value b))) + (cl-case (mal-type a) + ((list vector) (and (mal-seq-p b) + (mal-seq-= (mal-listify a) (mal-listify b)))) + (map (and (mal-map-p b) + (mal-map-= (mal-value a) (mal-value b)))) + (t (equal (mal-value a) (mal-value b))))) (defun mal-seq-= (a b) - (when (= (length (mal-value a)) - (length (mal-value b))) - (when (everyp 'mal-= (mal-listify a) (mal-listify b)) - t))) - -(defun everyp (predicate list-a list-b) - (let ((everyp t)) - (while (and everyp list-a list-b) - (let ((item-a (pop list-a)) - (item-b (pop list-b))) - (when (not (funcall predicate item-a item-b)) - (setq everyp nil)))) - everyp)) + (if a + (and b + (mal-= (car a) (car b)) + (mal-seq-= (cdr a) (cdr b))) + (null b))) (defun mal-map-= (a b) - (catch 'return - (let ((a* (mal-value a)) - (b* (mal-value b))) - (when (= (hash-table-count a*) - (hash-table-count b*)) - (maphash (lambda (key a-value) - (let ((b-value (gethash key b*))) - (if b-value - (when (not (mal-= a-value b-value)) - (throw 'return nil)) - (throw 'return nil)))) - a*) - ;; if we made it this far, the maps are equal - t)))) + (when (= (hash-table-count a) + (hash-table-count b)) + (catch 'return + (maphash (lambda (key a-value) + (let ((b-value (gethash key b))) + (unless (and b-value + (mal-= a-value b-value)) + (throw 'return nil)))) + a) + ;; if we made it this far, the maps are equal + t))) (define-hash-table-test 'mal-= 'mal-= 'sxhash) (defun mal-conj (seq &rest args) - (let ((type (mal-type seq)) - (value (mal-value seq))) - (if (eq type 'vector) - (mal-vector (vconcat (append (append value nil) args))) + (let ((value (mal-value seq))) + (cl-ecase (mal-type seq) + (vector + (mal-vector (vconcat (append (append value nil) args)))) + (list (while args (push (pop args) value)) - (mal-list value)))) + (mal-list value))))) (defun elisp-to-mal (arg) (cond @@ -143,6 +116,7 @@ (value (apply (mal-value fn*) args*))) (setf (aref atom 1) value))))) + (vec . ,(mal-fn (lambda (seq) (if (mal-vector-p seq) seq (mal-vector (mal-value seq)))))) (cons . ,(mal-fn (lambda (arg list) (mal-list (cons arg (mal-listify list)))))) (concat . ,(mal-fn (lambda (&rest lists) (let ((lists* (mapcar (lambda (item) (mal-listify item)) lists))) @@ -156,10 +130,8 @@ (first . ,(mal-fn (lambda (seq) (if (mal-nil-p seq) mal-nil - (let* ((list (mal-listify seq)) - (value (car list))) - (or value mal-nil)))))) - (rest . ,(mal-fn (lambda (seq) (mal-list (cdr (mal-listify seq)))))) + (or (car (mal-listify seq)) mal-nil))))) + (rest . ,(mal-fn (lambda (seq) (mal-list (unless (mal-nil-p seq) (cdr (mal-listify seq))))))) (throw . ,(mal-fn (lambda (mal-object) (signal 'mal-custom (list mal-object))))) @@ -185,7 +157,7 @@ (map? . ,(mal-fn (lambda (arg) (if (mal-map-p arg) mal-true mal-false)))) (symbol . ,(mal-fn (lambda (string) (mal-symbol (intern (mal-value string)))))) - (keyword . ,(mal-fn (lambda (string) (mal-keyword (intern (concat ":" (mal-value string))))))) + (keyword . ,(mal-fn (lambda (x) (if (mal-keyword-p x) x (mal-keyword (intern (concat ":" (mal-value x)))))))) (vector . ,(mal-fn (lambda (&rest args) (mal-vector (vconcat args))))) (hash-map . ,(mal-fn (lambda (&rest args) (let ((map (make-hash-table :test 'mal-=))) @@ -193,7 +165,7 @@ (puthash (pop args) (pop args) map)) (mal-map map))))) - (sequential? . ,(mal-fn 'mal-seq-p)) + (sequential? . ,(mal-fn (lambda (mal-object) (if (mal-seq-p mal-object) mal-true mal-false)))) (fn? . ,(mal-fn (lambda (arg) (if (or (mal-fn-p arg) (and (mal-func-p arg) (not (mal-func-macro-p arg)))) diff --git a/impls/elisp/mal/printer.el b/impls/elisp/mal/printer.el index ca864526..6e09f23c 100644 --- a/impls/elisp/mal/printer.el +++ b/impls/elisp/mal/printer.el @@ -1,34 +1,35 @@ +(require 'cl-lib) + (defun pr-str (form &optional print-readably) - (let ((type (mal-type form)) - (value (mal-value form))) - (cond - ((eq type 'nil) + (let ((value (mal-value form))) + (cl-ecase (mal-type form) + ('nil "nil") - ((eq type 'true) + (true "true") - ((eq type 'false) + (false "false") - ((eq type 'number) - (number-to-string (mal-value form))) - ((eq type 'string) + (number + (number-to-string value)) + (string (if print-readably (let ((print-escape-newlines t)) (prin1-to-string value)) value)) - ((or (eq type 'symbol) (eq type 'keyword)) + ((symbol keyword) (symbol-name value)) - ((eq type 'list) + (list (pr-list value print-readably)) - ((eq type 'vector) + (vector (pr-vector value print-readably)) - ((eq type 'map) + (map (pr-map value print-readably)) - ((eq type 'fn) + (fn "#") - ((eq type 'func) + (func "#") - ((eq type 'atom) - (format "(atom %s)" (mal-value value)))))) + (atom + (format "(atom %s)" (pr-str value print-readably)))))) (defun pr-list (form print-readably) (let ((items (mapconcat diff --git a/impls/elisp/mal/reader.el b/impls/elisp/mal/reader.el index 401b32bf..c8b92835 100644 --- a/impls/elisp/mal/reader.el +++ b/impls/elisp/mal/reader.el @@ -1,3 +1,5 @@ +(require 'cl-lib) + ;; HACK: `text-quoting-style' prettifies quotes in error messages on ;; Emacs 25, but no longer does from 26 upwards... (when (= emacs-major-version 25) @@ -33,29 +35,28 @@ (nreverse output)))) (defun read-form () - (let ((token (peek))) - (cond - ((string= token "'") + (pcase (peek) + ("'" (read-quote)) - ((string= token "`") + ("`" (read-quasiquote)) - ((string= token "~") + ("~" (read-unquote)) - ((string= token "~@") + ("~@" (read-splice-unquote)) - ((string= token "@") + ("@" (read-deref)) - ((string= token "^") + ("^" (read-with-meta)) - ((string= token "(") + ("(" (read-list)) - ((string= token "[") + ("[" (read-vector)) - ((string= token "{") + ("{" (read-map)) - (t + (_ ;; assume anything else is an atom - (read-atom))))) + (read-atom)))) (defun read-simple-reader-macro (symbol) (next) ; pop reader macro token diff --git a/impls/elisp/step1_read_print.el b/impls/elisp/step1_read_print.el index 0ba44e71..2e109a00 100644 --- a/impls/elisp/step1_read_print.el +++ b/impls/elisp/step1_read_print.el @@ -35,14 +35,12 @@ ;; empty input, carry on ) (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) (error ; catch-all (println (error-message-string err)) (backtrace))) diff --git a/impls/elisp/step2_eval.el b/impls/elisp/step2_eval.el index 68b66b53..a27cbd6c 100644 --- a/impls/elisp/step2_eval.el +++ b/impls/elisp/step2_eval.el @@ -20,20 +20,19 @@ (eval-ast ast env))) (defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) + (let ((value (mal-value ast))) + (cl-case (mal-type ast) + (symbol (let ((definition (gethash value env))) (or definition (error "Definition not found")))) - ((eq type 'list) + (list (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) + (vector (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) + (map (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) map) (mal-map map))) (t @@ -67,14 +66,12 @@ ;; empty input, carry on ) (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) (error ; catch-all (println (error-message-string err)) (backtrace))) diff --git a/impls/elisp/step3_env.el b/impls/elisp/step3_env.el index 9b2516a4..f05c178b 100644 --- a/impls/elisp/step3_env.el +++ b/impls/elisp/step3_env.el @@ -15,17 +15,15 @@ (defun EVAL (ast env) (if (and (mal-list-p ast) (mal-value ast)) (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) (a1 (cadr a)) (a1* (mal-value a1)) (a2 (nth 2 a))) - (cond - ((eq a0* 'def!) + (cl-case (mal-value (car a)) + (def! (let ((identifier a1*) (value (EVAL a2 env))) (mal-env-set env identifier value))) - ((eq a0* 'let*) + (let* (let ((env* (mal-env env)) (bindings (if (vectorp a1*) (append a1* nil) a1*)) (form a2)) @@ -43,20 +41,19 @@ (eval-ast ast env))) (defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) + (let ((value (mal-value ast))) + (cl-case (mal-type ast) + (symbol (let ((definition (mal-env-get env value))) (or definition (error "Definition not found")))) - ((eq type 'list) + (list (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) + (vector (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) + (map (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) map) (mal-map map))) (t @@ -90,14 +87,12 @@ ;; empty input, carry on ) (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) (error ; catch-all (println (error-message-string err)))) (setq eof t) diff --git a/impls/elisp/step4_if_fn_do.el b/impls/elisp/step4_if_fn_do.el index 0bf6a255..f4f2142e 100644 --- a/impls/elisp/step4_if_fn_do.el +++ b/impls/elisp/step4_if_fn_do.el @@ -19,29 +19,26 @@ (defun EVAL (ast env) (if (and (mal-list-p ast) (mal-value ast)) (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) - (cond - ((eq a0* 'def!) + (cl-case (mal-value (car a)) + (def! (let ((identifier (mal-value a1)) (value (EVAL a2 env))) (mal-env-set env identifier value))) - ((eq a0* 'let*) - (let* ((env* (mal-env env)) - (a1* (mal-value a1)) - (bindings (if (vectorp a1*) (append a1* nil) a1*)) - (form a2)) + (let* + (let ((env* (mal-env env)) + (bindings (mal-listify a1)) + (form a2)) (while bindings (let ((key (mal-value (pop bindings))) (value (EVAL (pop bindings) env*))) (mal-env-set env* key value))) (EVAL form env*))) - ((eq a0* 'do) + (do (car (last (mal-value (eval-ast (mal-list (cdr a)) env))))) - ((eq a0* 'if) + (if (let* ((condition (EVAL a1 env)) (condition-type (mal-type condition)) (then a2) @@ -52,7 +49,7 @@ (if else (EVAL else env) mal-nil)))) - ((eq a0* 'fn*) + (fn* (let ((binds (mapcar 'mal-value (mal-value a1))) (body a2)) (mal-fn @@ -62,31 +59,25 @@ (t ;; not a special form (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (fn* (cond - ((functionp fn) - fn) - ((mal-fn-p fn) - (mal-value fn)))) + (fn* (mal-value (car ast*))) (args (cdr ast*))) (apply fn* args))))) (eval-ast ast env))) (defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) + (let ((value (mal-value ast))) + (cl-case (mal-type ast) + (symbol (let ((definition (mal-env-get env value))) (or definition (error "Definition not found")))) - ((eq type 'list) + (list (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) + (vector (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) + (map (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) map) (mal-map map))) (t @@ -122,14 +113,12 @@ ;; empty input, carry on ) (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) (error ; catch-all (println (error-message-string err)))) (setq eof t) diff --git a/impls/elisp/step5_tco.el b/impls/elisp/step5_tco.el index e3410305..315cfa46 100644 --- a/impls/elisp/step5_tco.el +++ b/impls/elisp/step5_tco.el @@ -23,36 +23,32 @@ (while t (if (and (mal-list-p ast) (mal-value ast)) (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) - (cond - ((eq a0* 'def!) + (cl-case (mal-value (car a)) + (def! (let ((identifier (mal-value a1)) (value (EVAL a2 env))) (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'let*) - (let* ((env* (mal-env env)) - (bindings (mal-value a1)) - (form a2)) - (when (vectorp bindings) - (setq bindings (append bindings nil))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-listify a1)) + (form a2)) (while bindings (let ((key (mal-value (pop bindings))) (value (EVAL (pop bindings) env*))) (mal-env-set env* key value))) (setq env env* ast form))) ; TCO - ((eq a0* 'do) + (do (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) (when butlast (eval-ast (mal-list butlast) env)) (setq ast last))) ; TCO - ((eq a0* 'if) + (if (let* ((condition (EVAL a1 env)) (condition-type (mal-type condition)) (then a2) @@ -63,7 +59,7 @@ (if else (setq ast else) ; TCO (throw 'return mal-nil))))) - ((eq a0* 'fn*) + (fn* (let* ((binds (mapcar 'mal-value (mal-value a1))) (body a2) (fn (mal-fn @@ -82,29 +78,24 @@ args))) (setq env env* ast (mal-func-ast fn))) ; TCO - (let ((fn* (if (mal-fn-p fn) - ;; unbox user-defined function - (mal-value fn) - ;; use built-in function - fn))) + (let ((fn* (mal-value fn))) (throw 'return (apply fn* args)))))))) (throw 'return (eval-ast ast env)))))) (defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) + (let ((value (mal-value ast))) + (cl-case (mal-type ast) + (symbol (let ((definition (mal-env-get env value))) (or definition (error "Definition not found")))) - ((eq type 'list) + (list (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) + (vector (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) + (map (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) map) (mal-map map))) (t @@ -140,14 +131,12 @@ ;; empty input, carry on ) (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) (error ; catch-all (println (error-message-string err)))) (setq eof t) diff --git a/impls/elisp/step6_file.el b/impls/elisp/step6_file.el index 9a7ea686..88d09d0e 100644 --- a/impls/elisp/step6_file.el +++ b/impls/elisp/step6_file.el @@ -22,36 +22,32 @@ (while t (if (and (mal-list-p ast) (mal-value ast)) (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) - (cond - ((eq a0* 'def!) + (cl-case (mal-value (car a)) + (def! (let ((identifier (mal-value a1)) (value (EVAL a2 env))) (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'let*) - (let* ((env* (mal-env env)) - (bindings (mal-value a1)) - (form a2)) - (when (vectorp bindings) - (setq bindings (append bindings nil))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-listify a1)) + (form a2)) (while bindings (let ((key (mal-value (pop bindings))) (value (EVAL (pop bindings) env*))) (mal-env-set env* key value))) (setq env env* ast form))) ; TCO - ((eq a0* 'do) + (do (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) (when butlast (eval-ast (mal-list butlast) env)) (setq ast last))) ; TCO - ((eq a0* 'if) + (if (let* ((condition (EVAL a1 env)) (condition-type (mal-type condition)) (then a2) @@ -62,7 +58,7 @@ (if else (setq ast else) ; TCO (throw 'return mal-nil))))) - ((eq a0* 'fn*) + (fn* (let* ((binds (mapcar 'mal-value (mal-value a1))) (body a2) (fn (mal-fn @@ -87,20 +83,19 @@ (throw 'return (eval-ast ast env)))))) (defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) + (let ((value (mal-value ast))) + (cl-case (mal-type ast) + (symbol (let ((definition (mal-env-get env value))) (or definition (error "Definition not found")))) - ((eq type 'list) + (list (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) + (vector (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) + (map (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) map) (mal-map map))) (t @@ -136,14 +131,12 @@ ;; empty input, carry on ) (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) (error ; catch-all (println (error-message-string err))))) diff --git a/impls/elisp/step7_quote.el b/impls/elisp/step7_quote.el index d56f31fa..726fbee9 100644 --- a/impls/elisp/step7_quote.el +++ b/impls/elisp/step7_quote.el @@ -1,5 +1,6 @@ ;; -*- lexical-binding: t; -*- +(require 'cl-lib) (require 'mal/types) (require 'mal/func) (require 'mal/env) @@ -14,34 +15,30 @@ (fn (cdr binding))) (mal-env-set repl-env symbol fn))) -(defun mal-pair-p (mal-object) - (let ((type (mal-type mal-object)) - (value (mal-value mal-object))) - (if (and (or (eq type 'list) (eq type 'vector)) - (not (zerop (length value)))) - t - nil))) +(defun starts-with-p (ast sym) + (let ((l (mal-value ast))) + (and l + (let ((s (car l))) + (and (mal-symbol-p s) + (eq (mal-value s) sym)))))) + +(defun qq-reducer (elt acc) + (mal-list (if (and (mal-list-p elt) + (starts-with-p elt 'splice-unquote)) + (list (mal-symbol 'concat) (cadr (mal-value elt)) acc) + (list (mal-symbol 'cons) (quasiquote elt) acc)))) + +(defun qq-iter (elts) + (cl-reduce 'qq-reducer elts :from-end t :initial-value (mal-list nil))) (defun quasiquote (ast) - (if (not (mal-pair-p ast)) - (mal-list (list (mal-symbol 'quote) ast)) - (let* ((a (mal-listify ast)) - (a0 (car a)) - (a0... (cdr a)) - (a1 (cadr a))) - (cond - ((eq (mal-value a0) 'unquote) - a1) - ((and (mal-pair-p a0) - (eq (mal-value (car (mal-value a0))) - 'splice-unquote)) - (mal-list (list (mal-symbol 'concat) - (cadr (mal-value a0)) - (quasiquote (mal-list a0...))))) - (t - (mal-list (list (mal-symbol 'cons) - (quasiquote a0) - (quasiquote (mal-list a0...))))))))) + (cl-case (mal-type ast) + (list (if (starts-with-p ast 'unquote) + (cadr (mal-value ast)) + (qq-iter (mal-value ast)))) + (vector (mal-list (list (mal-symbol 'vec) (qq-iter (mal-value ast))))) + ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) + (t ast))) (defun READ (input) (read-str input)) @@ -51,40 +48,38 @@ (while t (if (and (mal-list-p ast) (mal-value ast)) (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) - (cond - ((eq a0* 'def!) + (cl-case (mal-value (car a)) + (def! (let ((identifier (mal-value a1)) (value (EVAL a2 env))) (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'let*) - (let* ((env* (mal-env env)) - (bindings (mal-value a1)) - (form a2)) - (when (vectorp bindings) - (setq bindings (append bindings nil))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-listify a1)) + (form a2)) (while bindings (let ((key (mal-value (pop bindings))) (value (EVAL (pop bindings) env*))) (mal-env-set env* key value))) (setq env env* ast form))) ; TCO - ((eq a0* 'quote) + (quote (throw 'return a1)) - ((eq a0* 'quasiquote) + (quasiquoteexpand + (throw 'return (quasiquote a1))) + (quasiquote (setq ast (quasiquote a1))) ; TCO - ((eq a0* 'do) + (do (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) (when butlast (eval-ast (mal-list butlast) env)) (setq ast last))) ; TCO - ((eq a0* 'if) + (if (let* ((condition (EVAL a1 env)) (condition-type (mal-type condition)) (then a2) @@ -95,7 +90,7 @@ (if else (setq ast else) ; TCO (throw 'return mal-nil))))) - ((eq a0* 'fn*) + (fn* (let* ((binds (mapcar 'mal-value (mal-value a1))) (body a2) (fn (mal-fn @@ -120,20 +115,19 @@ (throw 'return (eval-ast ast env)))))) (defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) + (let ((value (mal-value ast))) + (cl-case (mal-type ast) + (symbol (let ((definition (mal-env-get env value))) (or definition (error "Definition not found")))) - ((eq type 'list) + (list (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) + (vector (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) + (map (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) map) (mal-map map))) (t @@ -169,14 +163,12 @@ ;; empty input, carry on ) (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) (error ; catch-all (println (error-message-string err))))) diff --git a/impls/elisp/step8_macros.el b/impls/elisp/step8_macros.el index 2f1d74fc..077c2208 100644 --- a/impls/elisp/step8_macros.el +++ b/impls/elisp/step8_macros.el @@ -1,5 +1,6 @@ ;; -*- lexical-binding: t; -*- +(require 'cl-lib) (require 'mal/types) (require 'mal/func) (require 'mal/env) @@ -14,51 +15,39 @@ (fn (cdr binding))) (mal-env-set repl-env symbol fn))) -(defun mal-pair-p (mal-object) - (let ((type (mal-type mal-object)) - (value (mal-value mal-object))) - (if (and (or (eq type 'list) (eq type 'vector)) - (not (zerop (length value)))) - t - nil))) +(defun starts-with-p (ast sym) + (let ((s (car (mal-value ast)))) + (and (mal-symbol-p s) + (eq (mal-value s) sym)))) + +(defun qq-reducer (elt acc) + (mal-list (if (and (mal-list-p elt) + (starts-with-p elt 'splice-unquote)) + (list (mal-symbol 'concat) (cadr (mal-value elt)) acc) + (list (mal-symbol 'cons) (quasiquote elt) acc)))) + +(defun qq-iter (elts) + (cl-reduce 'qq-reducer elts :from-end t :initial-value (mal-list nil))) (defun quasiquote (ast) - (if (not (mal-pair-p ast)) - (mal-list (list (mal-symbol 'quote) ast)) - (let* ((a (mal-listify ast)) - (a0 (car a)) - (a0... (cdr a)) - (a1 (cadr a))) - (cond - ((eq (mal-value a0) 'unquote) - a1) - ((and (mal-pair-p a0) - (eq (mal-value (car (mal-value a0))) - 'splice-unquote)) - (mal-list (list (mal-symbol 'concat) - (cadr (mal-value a0)) - (quasiquote (mal-list a0...))))) - (t - (mal-list (list (mal-symbol 'cons) - (quasiquote a0) - (quasiquote (mal-list a0...))))))))) - -(defun macro-call-p (ast env) - (when (mal-list-p ast) - (let ((a0 (car (mal-value ast)))) - (when (mal-symbol-p a0) - (let ((value (mal-env-find env (mal-value a0)))) - (when (and (mal-func-p value) - (mal-func-macro-p value)) - t)))))) + (cl-case (mal-type ast) + (list (if (starts-with-p ast 'unquote) + (cadr (mal-value ast)) + (qq-iter (mal-value ast)))) + (vector (mal-list (list (mal-symbol 'vec) (qq-iter (mal-value ast))))) + ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) + (t ast))) (defun MACROEXPAND (ast env) - (while (macro-call-p ast env) - (let* ((a (mal-value ast)) - (a0* (mal-value (car a))) - (a0... (cdr a)) - (macro (mal-env-find env a0*))) - (setq ast (apply (mal-value (mal-func-fn macro)) a0...)))) + (let (a a0 macro) + (while (and (mal-list-p ast) + (setq a (mal-value ast)) + (setq a0 (car a)) + (mal-symbol-p a0) + (setq macro (mal-env-find env (mal-value a0))) + (mal-func-p macro) + (mal-func-macro-p macro)) + (setq ast (apply (mal-value (mal-func-fn macro)) (cdr a))))) ast) (defun READ (input) @@ -75,47 +64,45 @@ (throw 'return (eval-ast ast env))) (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) - (cond - ((eq a0* 'def!) - (let* ((identifier (mal-value a1)) - (value (EVAL a2 env))) + (cl-case (mal-value (car a)) + (def! + (let ((identifier (mal-value a1)) + (value (EVAL a2 env))) (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'let*) - (let* ((env* (mal-env env)) - (bindings (mal-value a1)) - (form a2)) - (when (vectorp bindings) - (setq bindings (append bindings nil))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-listify a1)) + (form a2)) (while bindings (let ((key (mal-value (pop bindings))) (value (EVAL (pop bindings) env*))) (mal-env-set env* key value))) (setq env env* ast form))) ; TCO - ((eq a0* 'quote) + (quote (throw 'return a1)) - ((eq a0* 'quasiquote) + (quasiquoteexpand + (throw 'return (quasiquote a1))) + (quasiquote (setq ast (quasiquote a1))) ; TCO - ((eq a0* 'defmacro!) + (defmacro! (let ((identifier (mal-value a1)) (value (EVAL a2 env))) (setf (aref (aref value 1) 4) t) (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'macroexpand) + (macroexpand (throw 'return (MACROEXPAND a1 env))) - ((eq a0* 'do) + (do (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) (when butlast (eval-ast (mal-list butlast) env)) (setq ast last))) ; TCO - ((eq a0* 'if) + (if (let* ((condition (EVAL a1 env)) (condition-type (mal-type condition)) (then a2) @@ -126,7 +113,7 @@ (if else (setq ast else) ; TCO (throw 'return mal-nil))))) - ((eq a0* 'fn*) + (fn* (let* ((binds (mapcar 'mal-value (mal-value a1))) (body a2) (fn (mal-fn @@ -150,20 +137,19 @@ (throw 'return (apply fn* args))))))))))) (defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) + (let ((value (mal-value ast))) + (cl-case (mal-type ast) + (symbol (let ((definition (mal-env-get env value))) (or definition (error "Definition not found")))) - ((eq type 'list) + (list (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) + (vector (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) + (map (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) map) (mal-map map))) (t @@ -200,14 +186,12 @@ ;; empty input, carry on ) (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) (error ; catch-all (println (error-message-string err))))) diff --git a/impls/elisp/step9_try.el b/impls/elisp/step9_try.el index 8360e060..8699e5d3 100644 --- a/impls/elisp/step9_try.el +++ b/impls/elisp/step9_try.el @@ -1,5 +1,6 @@ ;; -*- lexical-binding: t; -*- +(require 'cl-lib) (require 'mal/types) (require 'mal/func) (require 'mal/env) @@ -14,51 +15,39 @@ (fn (cdr binding))) (mal-env-set repl-env symbol fn))) -(defun mal-pair-p (mal-object) - (let ((type (mal-type mal-object)) - (value (mal-value mal-object))) - (if (and (or (eq type 'list) (eq type 'vector)) - (not (zerop (length value)))) - t - nil))) +(defun starts-with-p (ast sym) + (let ((s (car (mal-value ast)))) + (and (mal-symbol-p s) + (eq (mal-value s) sym)))) + +(defun qq-reducer (elt acc) + (mal-list (if (and (mal-list-p elt) + (starts-with-p elt 'splice-unquote)) + (list (mal-symbol 'concat) (cadr (mal-value elt)) acc) + (list (mal-symbol 'cons) (quasiquote elt) acc)))) + +(defun qq-iter (elts) + (cl-reduce 'qq-reducer elts :from-end t :initial-value (mal-list nil))) (defun quasiquote (ast) - (if (not (mal-pair-p ast)) - (mal-list (list (mal-symbol 'quote) ast)) - (let* ((a (mal-listify ast)) - (a0 (car a)) - (a0... (cdr a)) - (a1 (cadr a))) - (cond - ((eq (mal-value a0) 'unquote) - a1) - ((and (mal-pair-p a0) - (eq (mal-value (car (mal-value a0))) - 'splice-unquote)) - (mal-list (list (mal-symbol 'concat) - (cadr (mal-value a0)) - (quasiquote (mal-list a0...))))) - (t - (mal-list (list (mal-symbol 'cons) - (quasiquote a0) - (quasiquote (mal-list a0...))))))))) - -(defun macro-call-p (ast env) - (when (mal-list-p ast) - (let ((a0 (car (mal-value ast)))) - (when (mal-symbol-p a0) - (let ((value (mal-env-find env (mal-value a0)))) - (when (and (mal-func-p value) - (mal-func-macro-p value)) - t)))))) + (cl-case (mal-type ast) + (list (if (starts-with-p ast 'unquote) + (cadr (mal-value ast)) + (qq-iter (mal-value ast)))) + (vector (mal-list (list (mal-symbol 'vec) (qq-iter (mal-value ast))))) + ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) + (t ast))) (defun MACROEXPAND (ast env) - (while (macro-call-p ast env) - (let* ((a (mal-value ast)) - (a0* (mal-value (car a))) - (a0... (cdr a)) - (macro (mal-env-find env a0*))) - (setq ast (apply (mal-value (mal-func-fn macro)) a0...)))) + (let (a a0 macro) + (while (and (mal-list-p ast) + (setq a (mal-value ast)) + (setq a0 (car a)) + (mal-symbol-p a0) + (setq macro (mal-env-find env (mal-value a0))) + (mal-func-p macro) + (mal-func-macro-p macro)) + (setq ast (apply (mal-value (mal-func-fn macro)) (cdr a))))) ast) (defun READ (input) @@ -75,40 +64,38 @@ (throw 'return (eval-ast ast env))) (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) - (cond - ((eq a0* 'def!) - (let* ((identifier (mal-value a1)) - (value (EVAL a2 env))) + (cl-case (mal-value (car a)) + (def! + (let ((identifier (mal-value a1)) + (value (EVAL a2 env))) (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'let*) - (let* ((env* (mal-env env)) - (bindings (mal-value a1)) - (form a2)) - (when (vectorp bindings) - (setq bindings (append bindings nil))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-listify a1)) + (form a2)) (while bindings (let ((key (mal-value (pop bindings))) (value (EVAL (pop bindings) env*))) (mal-env-set env* key value))) (setq env env* ast form))) ; TCO - ((eq a0* 'quote) + (quote (throw 'return a1)) - ((eq a0* 'quasiquote) + (quasiquoteexpand + (throw 'return (quasiquote a1))) + (quasiquote (setq ast (quasiquote a1))) ; TCO - ((eq a0* 'defmacro!) + (defmacro! (let ((identifier (mal-value a1)) (value (EVAL a2 env))) (setf (aref (aref value 1) 4) t) (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'macroexpand) + (macroexpand (throw 'return (MACROEXPAND a1 env))) - ((eq a0* 'try*) + (try* (condition-case err (throw 'return (EVAL a1 env)) (error @@ -124,14 +111,14 @@ (env* (mal-env env (list identifier) (list err*)))) (throw 'return (EVAL form env*))) (signal (car err) (cdr err)))))) - ((eq a0* 'do) + (do (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) (when butlast (eval-ast (mal-list butlast) env)) (setq ast last))) ; TCO - ((eq a0* 'if) + (if (let* ((condition (EVAL a1 env)) (condition-type (mal-type condition)) (then a2) @@ -141,8 +128,8 @@ (setq ast then) ; TCO (if else (setq ast else) ; TCO - (throw 'return (mal-nil)))))) - ((eq a0* 'fn*) + (throw 'return mal-nil))))) + (fn* (let* ((binds (mapcar 'mal-value (mal-value a1))) (body a2) (fn (mal-fn @@ -166,20 +153,19 @@ (throw 'return (apply fn* args))))))))))) (defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) + (let ((value (mal-value ast))) + (cl-case (mal-type ast) + (symbol (let ((definition (mal-env-get env value))) (or definition (error "Definition not found")))) - ((eq type 'list) + (list (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) + (vector (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) + (map (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) map) (mal-map map))) (t @@ -216,14 +202,12 @@ ;; empty input, carry on ) (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) (error ; catch-all (println (error-message-string err))))) diff --git a/impls/elisp/stepA_mal.el b/impls/elisp/stepA_mal.el index 617dd62a..bb0a6bce 100644 --- a/impls/elisp/stepA_mal.el +++ b/impls/elisp/stepA_mal.el @@ -1,5 +1,6 @@ ;; -*- lexical-binding: t; -*- +(require 'cl-lib) (require 'mal/types) (require 'mal/func) (require 'mal/env) @@ -14,51 +15,39 @@ (fn (cdr binding))) (mal-env-set repl-env symbol fn))) -(defun mal-pair-p (mal-object) - (let ((type (mal-type mal-object)) - (value (mal-value mal-object))) - (if (and (or (eq type 'list) (eq type 'vector)) - (not (zerop (length value)))) - t - nil))) +(defun starts-with-p (ast sym) + (let ((s (car (mal-value ast)))) + (and (mal-symbol-p s) + (eq (mal-value s) sym)))) + +(defun qq-reducer (elt acc) + (mal-list (if (and (mal-list-p elt) + (starts-with-p elt 'splice-unquote)) + (list (mal-symbol 'concat) (cadr (mal-value elt)) acc) + (list (mal-symbol 'cons) (quasiquote elt) acc)))) + +(defun qq-iter (elts) + (cl-reduce 'qq-reducer elts :from-end t :initial-value (mal-list nil))) (defun quasiquote (ast) - (if (not (mal-pair-p ast)) - (mal-list (list (mal-symbol 'quote) ast)) - (let* ((a (mal-listify ast)) - (a0 (car a)) - (a0... (cdr a)) - (a1 (cadr a))) - (cond - ((eq (mal-value a0) 'unquote) - a1) - ((and (mal-pair-p a0) - (eq (mal-value (car (mal-value a0))) - 'splice-unquote)) - (mal-list (list (mal-symbol 'concat) - (cadr (mal-value a0)) - (quasiquote (mal-list a0...))))) - (t - (mal-list (list (mal-symbol 'cons) - (quasiquote a0) - (quasiquote (mal-list a0...))))))))) - -(defun macro-call-p (ast env) - (when (mal-list-p ast) - (let ((a0 (car (mal-value ast)))) - (when (mal-symbol-p a0) - (let ((value (mal-env-find env (mal-value a0)))) - (when (and (mal-func-p value) - (mal-func-macro-p value)) - t)))))) + (cl-case (mal-type ast) + (list (if (starts-with-p ast 'unquote) + (cadr (mal-value ast)) + (qq-iter (mal-value ast)))) + (vector (mal-list (list (mal-symbol 'vec) (qq-iter (mal-value ast))))) + ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) + (t ast))) (defun MACROEXPAND (ast env) - (while (macro-call-p ast env) - (let* ((a (mal-value ast)) - (a0* (mal-value (car a))) - (a0... (cdr a)) - (macro (mal-env-find env a0*))) - (setq ast (apply (mal-value (mal-func-fn macro)) a0...)))) + (let (a a0 macro) + (while (and (mal-list-p ast) + (setq a (mal-value ast)) + (setq a0 (car a)) + (mal-symbol-p a0) + (setq macro (mal-env-find env (mal-value a0))) + (mal-func-p macro) + (mal-func-macro-p macro)) + (setq ast (apply (mal-value (mal-func-fn macro)) (cdr a))))) ast) (defun READ (input) @@ -75,40 +64,38 @@ (throw 'return (eval-ast ast env))) (let* ((a (mal-value ast)) - (a0 (car a)) - (a0* (mal-value a0)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) - (cond - ((eq a0* 'def!) - (let* ((identifier (mal-value a1)) - (value (EVAL a2 env))) + (cl-case (mal-value (car a)) + (def! + (let ((identifier (mal-value a1)) + (value (EVAL a2 env))) (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'let*) - (let* ((env* (mal-env env)) - (bindings (mal-value a1)) - (form a2)) - (when (vectorp bindings) - (setq bindings (append bindings nil))) + (let* + (let ((env* (mal-env env)) + (bindings (mal-listify a1)) + (form a2)) (while bindings (let ((key (mal-value (pop bindings))) (value (EVAL (pop bindings) env*))) (mal-env-set env* key value))) (setq env env* ast form))) ; TCO - ((eq a0* 'quote) + (quote (throw 'return a1)) - ((eq a0* 'quasiquote) + (quasiquoteexpand + (throw 'return (quasiquote a1))) + (quasiquote (setq ast (quasiquote a1))) ; TCO - ((eq a0* 'defmacro!) + (defmacro! (let ((identifier (mal-value a1)) (value (EVAL a2 env))) (setf (aref (aref value 1) 4) t) (throw 'return (mal-env-set env identifier value)))) - ((eq a0* 'macroexpand) + (macroexpand (throw 'return (MACROEXPAND a1 env))) - ((eq a0* 'try*) + (try* (condition-case err (throw 'return (EVAL a1 env)) (error @@ -124,14 +111,14 @@ (env* (mal-env env (list identifier) (list err*)))) (throw 'return (EVAL form env*))) (signal (car err) (cdr err)))))) - ((eq a0* 'do) + (do (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) (when butlast (eval-ast (mal-list butlast) env)) (setq ast last))) ; TCO - ((eq a0* 'if) + (if (let* ((condition (EVAL a1 env)) (condition-type (mal-type condition)) (then a2) @@ -142,7 +129,7 @@ (if else (setq ast else) ; TCO (throw 'return mal-nil))))) - ((eq a0* 'fn*) + (fn* (let* ((binds (mapcar 'mal-value (mal-value a1))) (body a2) (fn (mal-fn @@ -166,20 +153,19 @@ (throw 'return (apply fn* args))))))))))) (defun eval-ast (ast env) - (let ((type (mal-type ast)) - (value (mal-value ast))) - (cond - ((eq type 'symbol) + (let ((value (mal-value ast))) + (cl-case (mal-type ast) + (symbol (let ((definition (mal-env-get env value))) (or definition (error "Definition not found")))) - ((eq type 'list) + (list (mal-list (mapcar (lambda (item) (EVAL item env)) value))) - ((eq type 'vector) + (vector (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) - ((eq type 'map) + (map (let ((map (copy-hash-table value))) - (maphash (lambda (key value) - (puthash key (EVAL value env) map)) + (maphash (lambda (key val) + (puthash key (EVAL val env) map)) map) (mal-map map))) (t @@ -217,14 +203,12 @@ ;; empty input, carry on ) (unterminated-sequence - (let* ((type (cadr err)) - (end - (cond - ((eq type 'string) ?\") - ((eq type 'list) ?\)) - ((eq type 'vector) ?\]) - ((eq type 'map) ?})))) - (princ (format "Expected '%c', got EOF\n" end)))) + (princ (format "Expected '%c', got EOF\n" + (cl-case (cadr err) + (string ?\") + (list ?\)) + (vector ?\]) + (map ?}))))) (error ; catch-all (println (error-message-string err))))) diff --git a/impls/elixir/lib/mal/core.ex b/impls/elixir/lib/mal/core.ex index 8acbca11..f8074c6d 100644 --- a/impls/elixir/lib/mal/core.ex +++ b/impls/elixir/lib/mal/core.ex @@ -30,6 +30,7 @@ defmodule Mal.Core do "keyword" => &keyword/1, "symbol?" => &symbol?/1, "cons" => &cons/1, + "vec" => &vec/1, "vector?" => &vector?/1, "assoc" => &assoc/1, "dissoc" => &dissoc/1, @@ -185,6 +186,11 @@ defmodule Mal.Core do |> list end + defp vec([{:list, xs, _}]), do: vector(xs) + defp vec([{:vector, xs, _}]), do: vector(xs) + defp vec([_]), do: throw({:error, "vec: arg type"}) + defp vec(_), do: throw({:error, "vec: arg count"}) + defp assoc([{:map, hash_map, meta} | pairs]) do {:map, merge, _} = hash_map(pairs) {:map, Map.merge(hash_map, merge), meta} diff --git a/impls/elixir/lib/mix/tasks/step7_quote.ex b/impls/elixir/lib/mix/tasks/step7_quote.ex index 195cb264..43155ee6 100644 --- a/impls/elixir/lib/mix/tasks/step7_quote.ex +++ b/impls/elixir/lib/mix/tasks/step7_quote.ex @@ -90,29 +90,20 @@ defmodule Mix.Tasks.Step7Quote do end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) - defp quasi_list([], _env), do: list([{:symbol, "quote"}, list([])]) - defp quasi_list([{:symbol, "unquote"}, arg], _env), do: arg - defp quasi_list([{:list, [{:symbol, "splice-unquote"}, first], _meta} | tail], env) do - right = tail - |> list - |> quasiquote(env) + defp quasiquote({:list, [{:symbol, "unquote"}, arg], _}), do: arg + defp quasiquote({:list, [{:symbol, "unquote"}| _], _}), do: throw({:error, "unquote: arg count"}) + defp quasiquote({:list, xs, _}), do: qq_foldr(xs) + defp quasiquote({:vector, xs, _}), do: list([{:symbol, "vec"}, qq_foldr(xs)]) + defp quasiquote({:symbol, sym}), do: list([{:symbol, "quote"}, {:symbol, sym}]) + defp quasiquote({:map, ast, meta}), do: list([{:symbol, "quote"}, {:map, ast, meta}]) + defp quasiquote(ast), do: ast - list([{:symbol, "concat"}, first, right]) - end - defp quasi_list([head | tail], env) do - left = quasiquote(head, env) - right = tail - |> list - |> quasiquote(env) + defp qq_foldr([]), do: list([]) + defp qq_foldr([x|xs]), do: qq_loop(x, qq_foldr xs) - list([{:symbol, "cons"}, left, right]) - end - - defp quasiquote({list_type, ast, _}, env) - when list_type in [:list, :vector] do - quasi_list(ast, env) - end - defp quasiquote(ast, _env), do: list([{:symbol, "quote"}, ast]) + defp qq_loop({:list, [{:symbol, "splice-unquote"}, arg], _}, acc), do: list([{:symbol, "concat"}, arg, acc]) + defp qq_loop({:list, [{:symbol, "splice-unquote"}| _], _}, _), do: throw({:error, "splice-unquote: arg count"}) + defp qq_loop(elt, acc), do: list([{:symbol, "cons"}, quasiquote(elt), acc]) defp eval({:list, [], _} = empty_ast, _env), do: empty_ast defp eval({:list, ast, meta}, env), do: eval_list(ast, env, meta) @@ -165,8 +156,12 @@ defmodule Mix.Tasks.Step7Quote do defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg + defp eval_list([{:symbol, "quasiquoteexpand"}, ast], _, _) do + quasiquote(ast) + end + defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do - quasiquote(ast, env) + ast |> quasiquote |> eval(env) end diff --git a/impls/elixir/lib/mix/tasks/step8_macros.ex b/impls/elixir/lib/mix/tasks/step8_macros.ex index d78e832f..84880955 100644 --- a/impls/elixir/lib/mix/tasks/step8_macros.ex +++ b/impls/elixir/lib/mix/tasks/step8_macros.ex @@ -102,29 +102,20 @@ defmodule Mix.Tasks.Step8Macros do end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) - defp quasi_list([], _env), do: list([{:symbol, "quote"}, list([])]) - defp quasi_list([{:symbol, "unquote"}, arg], _env), do: arg - defp quasi_list([{:list, [{:symbol, "splice-unquote"}, first], _meta} | tail], env) do - right = tail - |> list - |> quasiquote(env) + defp quasiquote({:list, [{:symbol, "unquote"}, arg], _}), do: arg + defp quasiquote({:list, [{:symbol, "unquote"}| _], _}), do: throw({:error, "unquote: arg count"}) + defp quasiquote({:list, xs, _}), do: qq_foldr(xs) + defp quasiquote({:vector, xs, _}), do: list([{:symbol, "vec"}, qq_foldr(xs)]) + defp quasiquote({:symbol, sym}), do: list([{:symbol, "quote"}, {:symbol, sym}]) + defp quasiquote({:map, ast, meta}), do: list([{:symbol, "quote"}, {:map, ast, meta}]) + defp quasiquote(ast), do: ast - list([{:symbol, "concat"}, first, right]) - end - defp quasi_list([head | tail], env) do - left = quasiquote(head, env) - right = tail - |> list - |> quasiquote(env) + defp qq_foldr([]), do: list([]) + defp qq_foldr([x|xs]), do: qq_loop(x, qq_foldr xs) - list([{:symbol, "cons"}, left, right]) - end - - defp quasiquote({list_type, ast, _}, env) - when list_type in [:list, :vector] do - quasi_list(ast, env) - end - defp quasiquote(ast, _env), do: list([{:symbol, "quote"}, ast]) + defp qq_loop({:list, [{:symbol, "splice-unquote"}, arg], _}, acc), do: list([{:symbol, "concat"}, arg, acc]) + defp qq_loop({:list, [{:symbol, "splice-unquote"}| _], _}, _), do: throw({:error, "splice-unquote: arg count"}) + defp qq_loop(elt, acc), do: list([{:symbol, "cons"}, quasiquote(elt), acc]) defp macro_call?({:list, [{:symbol, key} | _tail], _}, env) do case Mal.Env.get(env, key) do @@ -212,8 +203,12 @@ defmodule Mix.Tasks.Step8Macros do defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg + defp eval_list([{:symbol, "quasiquoteexpand"}, ast], _, _) do + quasiquote(ast) + end + defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do - quasiquote(ast, env) + ast |> quasiquote |> eval(env) end diff --git a/impls/elixir/lib/mix/tasks/step9_try.ex b/impls/elixir/lib/mix/tasks/step9_try.ex index 4fb61a53..8c3449a9 100644 --- a/impls/elixir/lib/mix/tasks/step9_try.ex +++ b/impls/elixir/lib/mix/tasks/step9_try.ex @@ -102,29 +102,20 @@ defmodule Mix.Tasks.Step9Try do end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) - defp quasi_list([], _env), do: list([{:symbol, "quote"}, list([])]) - defp quasi_list([{:symbol, "unquote"}, arg], _env), do: arg - defp quasi_list([{:list, [{:symbol, "splice-unquote"}, first], _meta} | tail], env) do - right = tail - |> list - |> quasiquote(env) + defp quasiquote({:list, [{:symbol, "unquote"}, arg], _}), do: arg + defp quasiquote({:list, [{:symbol, "unquote"}| _], _}), do: throw({:error, "unquote: arg count"}) + defp quasiquote({:list, xs, _}), do: qq_foldr(xs) + defp quasiquote({:vector, xs, _}), do: list([{:symbol, "vec"}, qq_foldr(xs)]) + defp quasiquote({:symbol, sym}), do: list([{:symbol, "quote"}, {:symbol, sym}]) + defp quasiquote({:map, ast, meta}), do: list([{:symbol, "quote"}, {:map, ast, meta}]) + defp quasiquote(ast), do: ast - list([{:symbol, "concat"}, first, right]) - end - defp quasi_list([head | tail], env) do - left = quasiquote(head, env) - right = tail - |> list - |> quasiquote(env) + defp qq_foldr([]), do: list([]) + defp qq_foldr([x|xs]), do: qq_loop(x, qq_foldr xs) - list([{:symbol, "cons"}, left, right]) - end - - defp quasiquote({list_type, ast, _}, env) - when list_type in [:list, :vector] do - quasi_list(ast, env) - end - defp quasiquote(ast, _env), do: list([{:symbol, "quote"}, ast]) + defp qq_loop({:list, [{:symbol, "splice-unquote"}, arg], _}, acc), do: list([{:symbol, "concat"}, arg, acc]) + defp qq_loop({:list, [{:symbol, "splice-unquote"}| _], _}, _), do: throw({:error, "splice-unquote: arg count"}) + defp qq_loop(elt, acc), do: list([{:symbol, "cons"}, quasiquote(elt), acc]) defp macro_call?({:list, [{:symbol, key} | _tail], _}, env) do case Mal.Env.get(env, key) do @@ -212,8 +203,12 @@ defmodule Mix.Tasks.Step9Try do defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg + defp eval_list([{:symbol, "quasiquoteexpand"}, ast], _, _) do + quasiquote(ast) + end + defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do - quasiquote(ast, env) + ast |> quasiquote |> eval(env) end diff --git a/impls/elixir/lib/mix/tasks/stepA_mal.ex b/impls/elixir/lib/mix/tasks/stepA_mal.ex index b0eaf1e2..f80375d1 100644 --- a/impls/elixir/lib/mix/tasks/stepA_mal.ex +++ b/impls/elixir/lib/mix/tasks/stepA_mal.ex @@ -111,29 +111,20 @@ defmodule Mix.Tasks.StepAMal do end defp eval_bindings(_bindings, _env), do: throw({:error, "Unbalanced let* bindings"}) - defp quasi_list([], _env), do: list([{:symbol, "quote"}, list([])]) - defp quasi_list([{:symbol, "unquote"}, arg], _env), do: arg - defp quasi_list([{:list, [{:symbol, "splice-unquote"}, first], _meta} | tail], env) do - right = tail - |> list - |> quasiquote(env) + defp quasiquote({:list, [{:symbol, "unquote"}, arg], _}), do: arg + defp quasiquote({:list, [{:symbol, "unquote"}| _], _}), do: throw({:error, "unquote: arg count"}) + defp quasiquote({:list, xs, _}), do: qq_foldr(xs) + defp quasiquote({:vector, xs, _}), do: list([{:symbol, "vec"}, qq_foldr(xs)]) + defp quasiquote({:symbol, sym}), do: list([{:symbol, "quote"}, {:symbol, sym}]) + defp quasiquote({:map, ast, meta}), do: list([{:symbol, "quote"}, {:map, ast, meta}]) + defp quasiquote(ast), do: ast - list([{:symbol, "concat"}, first, right]) - end - defp quasi_list([head | tail], env) do - left = quasiquote(head, env) - right = tail - |> list - |> quasiquote(env) + defp qq_foldr([]), do: list([]) + defp qq_foldr([x|xs]), do: qq_loop(x, qq_foldr xs) - list([{:symbol, "cons"}, left, right]) - end - - defp quasiquote({list_type, ast, _}, env) - when list_type in [:list, :vector] do - quasi_list(ast, env) - end - defp quasiquote(ast, _env), do: list([{:symbol, "quote"}, ast]) + defp qq_loop({:list, [{:symbol, "splice-unquote"}, arg], _}, acc), do: list([{:symbol, "concat"}, arg, acc]) + defp qq_loop({:list, [{:symbol, "splice-unquote"}| _], _}, _), do: throw({:error, "splice-unquote: arg count"}) + defp qq_loop(elt, acc), do: list([{:symbol, "cons"}, quasiquote(elt), acc]) defp macro_call?({:list, [{:symbol, key} | _tail], _}, env) do case Mal.Env.get(env, key) do @@ -221,8 +212,12 @@ defmodule Mix.Tasks.StepAMal do defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg + defp eval_list([{:symbol, "quasiquoteexpand"}, ast], _, _) do + quasiquote(ast) + end + defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do - quasiquote(ast, env) + ast |> quasiquote |> eval(env) end diff --git a/impls/elm/Core.elm b/impls/elm/Core.elm index 07e6eced..5dca34bc 100644 --- a/impls/elm/Core.elm +++ b/impls/elm/Core.elm @@ -390,6 +390,13 @@ ns = List.foldl (go >> Eval.andThen) (Eval.succeed []) args |> Eval.map MalList + vec args = + case args of + [MalVector xs] -> Eval.succeed <| MalVector xs + [MalList xs] -> Eval.succeed <| MalVector <| Array.fromList xs + [_] -> Eval.fail "vec: arg type" + _ -> Eval.fail "vec: arg count" + nth args = let get list index = @@ -921,6 +928,7 @@ ns = |> Env.set "typeof" (makeFn typeof) |> Env.set "cons" (makeFn cons) |> Env.set "concat" (makeFn concat) + |> Env.set "vec" (makeFn vec) |> Env.set "nth" (makeFn nth) |> Env.set "first" (makeFn first) |> Env.set "rest" (makeFn rest) diff --git a/impls/elm/step7_quote.elm b/impls/elm/step7_quote.elm index 4d8f998f..2341f94e 100644 --- a/impls/elm/step7_quote.elm +++ b/impls/elm/step7_quote.elm @@ -289,6 +289,11 @@ evalNoApply ast = MalList ((MalSymbol "quote") :: args) -> evalQuote args + MalList [MalSymbol "quasiquoteexpand", expr] -> + Eval.succeed <| evalQuasiQuote expr + MalList (MalSymbol "quasiquoteexpand" :: _) -> + Eval.fail "quasiquoteexpand: arg count" + MalList ((MalSymbol "quasiquote") :: args) -> case args of [ expr ] -> @@ -587,35 +592,27 @@ evalQuote args = evalQuasiQuote : MalExpr -> MalExpr evalQuasiQuote expr = let - apply list empty = - case list of - [ MalSymbol "unquote", ast ] -> - ast - - (MalList [ MalSymbol "splice-unquote", ast ]) :: rest -> - makeCall "concat" - [ ast - , evalQuasiQuote (MalList rest) - ] - - ast :: rest -> - makeCall "cons" - [ evalQuasiQuote ast - , evalQuasiQuote (MalList rest) - ] - + qq_loop : MalExpr -> MalExpr -> MalExpr + qq_loop elt acc = + case elt of + (MalList [MalSymbol "splice-unquote", form]) -> + MalList <| [MalSymbol "concat", form, acc ] _ -> - makeCall "quote" [ empty ] + MalList <| [MalSymbol "cons", evalQuasiQuote elt, acc ] in case expr of - MalList list -> - apply list (MalList []) - - MalVector vec -> - apply (Array.toList vec) (MalVector Array.empty) - - ast -> - makeCall "quote" [ ast ] + (MalList [MalSymbol "unquote", form]) -> + form + (MalList xs) -> + List.foldr qq_loop (MalList []) xs + (MalVector xs) -> + MalList <| (\x -> [MalSymbol "vec", x]) <| Array.foldr qq_loop (MalList []) xs + (MalSymbol _) -> + MalList <| [MalSymbol "quote", expr] + (MalMap _) -> + MalList <| [MalSymbol "quote", expr] + _ -> + expr print : Env -> MalExpr -> String diff --git a/impls/elm/step8_macros.elm b/impls/elm/step8_macros.elm index 39500123..5167642b 100644 --- a/impls/elm/step8_macros.elm +++ b/impls/elm/step8_macros.elm @@ -300,6 +300,11 @@ evalNoApply ast = MalList ((MalSymbol "quote") :: args) -> evalQuote args + MalList [MalSymbol "quasiquoteexpand", expr] -> + Eval.succeed <| evalQuasiQuote expr + MalList (MalSymbol "quasiquoteexpand" :: _) -> + Eval.fail "quasiquoteexpand: arg count" + MalList ((MalSymbol "quasiquote") :: args) -> case args of [ expr ] -> @@ -634,35 +639,27 @@ evalQuote args = evalQuasiQuote : MalExpr -> MalExpr evalQuasiQuote expr = let - apply list empty = - case list of - [ MalSymbol "unquote", ast ] -> - ast - - (MalList [ MalSymbol "splice-unquote", ast ]) :: rest -> - makeCall "concat" - [ ast - , evalQuasiQuote (MalList rest) - ] - - ast :: rest -> - makeCall "cons" - [ evalQuasiQuote ast - , evalQuasiQuote (MalList rest) - ] - + qq_loop : MalExpr -> MalExpr -> MalExpr + qq_loop elt acc = + case elt of + (MalList [MalSymbol "splice-unquote", form]) -> + MalList <| [MalSymbol "concat", form, acc ] _ -> - makeCall "quote" [ empty ] + MalList <| [MalSymbol "cons", evalQuasiQuote elt, acc ] in case expr of - MalList list -> - apply list (MalList []) - - MalVector vec -> - apply (Array.toList vec) (MalVector Array.empty) - - ast -> - makeCall "quote" [ ast ] + (MalList [MalSymbol "unquote", form]) -> + form + (MalList xs) -> + List.foldr qq_loop (MalList []) xs + (MalVector xs) -> + MalList <| (\x -> [MalSymbol "vec", x]) <| Array.foldr qq_loop (MalList []) xs + (MalSymbol _) -> + MalList <| [MalSymbol "quote", expr] + (MalMap _) -> + MalList <| [MalSymbol "quote", expr] + _ -> + expr macroexpand : MalExpr -> Eval MalExpr diff --git a/impls/elm/step9_try.elm b/impls/elm/step9_try.elm index aadd128b..88fe0e7b 100644 --- a/impls/elm/step9_try.elm +++ b/impls/elm/step9_try.elm @@ -297,6 +297,11 @@ evalNoApply ast = MalList ((MalSymbol "quote") :: args) -> evalQuote args + MalList [MalSymbol "quasiquoteexpand", expr] -> + Eval.succeed <| evalQuasiQuote expr + MalList (MalSymbol "quasiquoteexpand" :: _) -> + Eval.fail "quasiquoteexpand: arg count" + MalList ((MalSymbol "quasiquote") :: args) -> case args of [ expr ] -> @@ -636,35 +641,27 @@ evalQuote args = evalQuasiQuote : MalExpr -> MalExpr evalQuasiQuote expr = let - apply list empty = - case list of - [ MalSymbol "unquote", ast ] -> - ast - - (MalList [ MalSymbol "splice-unquote", ast ]) :: rest -> - makeCall "concat" - [ ast - , evalQuasiQuote (MalList rest) - ] - - ast :: rest -> - makeCall "cons" - [ evalQuasiQuote ast - , evalQuasiQuote (MalList rest) - ] - + qq_loop : MalExpr -> MalExpr -> MalExpr + qq_loop elt acc = + case elt of + (MalList [MalSymbol "splice-unquote", form]) -> + MalList <| [MalSymbol "concat", form, acc ] _ -> - makeCall "quote" [ empty ] + MalList <| [MalSymbol "cons", evalQuasiQuote elt, acc ] in case expr of - MalList list -> - apply list (MalList []) - - MalVector vec -> - apply (Array.toList vec) (MalVector Array.empty) - - ast -> - makeCall "quote" [ ast ] + (MalList [MalSymbol "unquote", form]) -> + form + (MalList xs) -> + List.foldr qq_loop (MalList []) xs + (MalVector xs) -> + MalList <| (\x -> [MalSymbol "vec", x]) <| Array.foldr qq_loop (MalList []) xs + (MalSymbol _) -> + MalList <| [MalSymbol "quote", expr] + (MalMap _) -> + MalList <| [MalSymbol "quote", expr] + _ -> + expr macroexpand : MalExpr -> Eval MalExpr diff --git a/impls/elm/stepA_mal.elm b/impls/elm/stepA_mal.elm index 54d74c1f..7a436eed 100644 --- a/impls/elm/stepA_mal.elm +++ b/impls/elm/stepA_mal.elm @@ -299,6 +299,11 @@ evalNoApply ast = MalList ((MalSymbol "quote") :: args) -> evalQuote args + MalList [MalSymbol "quasiquoteexpand", expr] -> + Eval.succeed <| evalQuasiQuote expr + MalList (MalSymbol "quasiquoteexpand" :: _) -> + Eval.fail "quasiquoteexpand: arg count" + MalList ((MalSymbol "quasiquote") :: args) -> case args of [ expr ] -> @@ -643,35 +648,27 @@ evalQuote args = evalQuasiQuote : MalExpr -> MalExpr evalQuasiQuote expr = let - apply list empty = - case list of - [ MalSymbol "unquote", ast ] -> - ast - - (MalList [ MalSymbol "splice-unquote", ast ]) :: rest -> - makeCall "concat" - [ ast - , evalQuasiQuote (MalList rest) - ] - - ast :: rest -> - makeCall "cons" - [ evalQuasiQuote ast - , evalQuasiQuote (MalList rest) - ] - + qq_loop : MalExpr -> MalExpr -> MalExpr + qq_loop elt acc = + case elt of + (MalList [MalSymbol "splice-unquote", form]) -> + MalList <| [MalSymbol "concat", form, acc ] _ -> - makeCall "quote" [ empty ] + MalList <| [MalSymbol "cons", evalQuasiQuote elt, acc ] in case expr of - MalList list -> - apply list (MalList []) - - MalVector vec -> - apply (Array.toList vec) (MalVector Array.empty) - - ast -> - makeCall "quote" [ ast ] + (MalList [MalSymbol "unquote", form]) -> + form + (MalList xs) -> + List.foldr qq_loop (MalList []) xs + (MalVector xs) -> + MalList <| (\x -> [MalSymbol "vec", x]) <| Array.foldr qq_loop (MalList []) xs + (MalSymbol _) -> + MalList <| [MalSymbol "quote", expr] + (MalMap _) -> + MalList <| [MalSymbol "quote", expr] + _ -> + expr macroexpand : MalExpr -> Eval MalExpr diff --git a/impls/erlang/src/core.erl b/impls/erlang/src/core.erl index 9aa2ba75..2566a965 100644 --- a/impls/erlang/src/core.erl +++ b/impls/erlang/src/core.erl @@ -269,6 +269,11 @@ concat(Args) -> error:Reason -> {error, Reason} end. +vec([{list, List, _Meta}]) -> {vector, List, nil}; +vec([{vector, List, _Meta}]) -> {vector, List, nil}; +vec([_]) -> {error, "vec: arg type"}; +vec(_) -> {error, "vec: arg count"}. + mal_throw([Reason]) -> throw(Reason); mal_throw(_) -> @@ -381,6 +386,7 @@ ns() -> "time-ms" => fun time_ms/1, "true?" => fun true_p/1, "vals" => fun types:map_values/1, + "vec" => fun vec/1, "vector" => fun types:vector/1, "vector?" => fun types:vector_p/1, "with-meta" => fun types:with_meta/1 diff --git a/impls/erlang/src/step7_quote.erl b/impls/erlang/src/step7_quote.erl index 9cbeb83b..8588afbd 100644 --- a/impls/erlang/src/step7_quote.erl +++ b/impls/erlang/src/step7_quote.erl @@ -92,6 +92,10 @@ eval({list, [{symbol, "quote"}, AST], _Meta}, _Env) -> AST; eval({list, [{symbol, "quote"}|_], _Meta}, _Env) -> error("quote requires 1 argument"); +eval({list, [{symbol, "quasiquoteexpand"}, AST], _Meta}, Env) -> + quasiquote(AST); +eval({list, [{symbol, "quasiquoteexpand"}|_], _Meta}, _Env) -> + error("quasiquoteexpand requires 1 argument"); eval({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> eval(quasiquote(AST), Env); eval({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> @@ -152,28 +156,24 @@ list_to_proplist([_H], _AccIn) -> list_to_proplist([K,V|T], AccIn) -> list_to_proplist(T, [{K, V}|AccIn]). -quasiquote({T, [{list, [{symbol, "splice-unquote"}, First], _M1}|Rest], _M2}) when T == list orelse T == vector -> - % 3. if is_pair of first element of ast is true and the first element of - % first element of ast (ast[0][0]) is a symbol named "splice-unquote": - % return a new list containing: a symbol named "concat", the second element - % of first element of ast (ast[0][1]), and the result of calling quasiquote - % with the second through last element of ast. - {list, [{symbol, "concat"}, First] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote({T, [{symbol, "splice-unquote"}], _M}) when T == list orelse T == vector -> +qqLoop ({list, [{symbol, "splice-unquote"}, Arg], _Meta}, Acc) -> + {list, [{symbol, "concat"}, Arg, Acc], nil}; +qqLoop({list, [{symbol, "splice-unquote"}|_], _Meta}, _Acc) -> {error, "splice-unquote requires an argument"}; -quasiquote({T, [{symbol, "unquote"}, AST], _M}) when T == list orelse T == vector -> - % 2. else if the first element of ast is a symbol named "unquote": return - % the second element of ast. - AST; -quasiquote({T, [{symbol, "unquote"}|_], _M}) when T == list orelse T == vector -> - {error, "unquote expects one argument"}; -quasiquote({T, [First|Rest], _M}) when T == list orelse T == vector -> - % 4. otherwise: return a new list containing: a symbol named "cons", - % the result of calling quasiquote on first element of ast (ast[0]), - % and result of calling quasiquote with the second through last - % element of ast. - {list, [{symbol, "cons"}, quasiquote(First)] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote(AST) -> - % 1. if is_pair of ast is false: return a new list containing: - % a symbol named "quote" and ast. - {list, [{symbol, "quote"}, AST], nil}. +qqLoop(Elt, Acc) -> + {list, [{symbol, "cons"}, quasiquote(Elt), Acc], nil}. + +quasiquote({list, [{symbol, "unquote"}, Arg], _Meta}) -> + Arg; +quasiquote({list, [{symbol, "unquote"}|_], _Meta}) -> + error("unquote requires 1 argument"); +quasiquote({list, List, _Meta}) -> + lists:foldr(fun qqLoop/2, {list, [], nil}, List); +quasiquote({vector, List, _Meta}) -> + {list, [{symbol, "vec"}, lists:foldr(fun qqLoop/2, {list, [], nil}, List)], nil}; +quasiquote({symbol, _Symbol} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote({map, _Map, _Meta} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote(Arg) -> + Arg. diff --git a/impls/erlang/src/step8_macros.erl b/impls/erlang/src/step8_macros.erl index 13f7b0e1..1e024f73 100644 --- a/impls/erlang/src/step8_macros.erl +++ b/impls/erlang/src/step8_macros.erl @@ -106,6 +106,10 @@ eval_list({list, [{symbol, "quote"}, AST], _Meta}, _Env) -> AST; eval_list({list, [{symbol, "quote"}|_], _Meta}, _Env) -> error("quote requires 1 argument"); +eval_list({list, [{symbol, "quasiquoteexpand"}, AST], _Meta}, Env) -> + quasiquote(AST); +eval_list({list, [{symbol, "quasiquoteexpand"}|_], _Meta}, _Env) -> + error("quasiquoteexpand requires 1 argument"); eval_list({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> eval(quasiquote(AST), Env); eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> @@ -181,31 +185,27 @@ list_to_proplist([_H], _AccIn) -> list_to_proplist([K,V|T], AccIn) -> list_to_proplist(T, [{K, V}|AccIn]). -quasiquote({T, [{list, [{symbol, "splice-unquote"}, First], _M1}|Rest], _M2}) when T == list orelse T == vector -> - % 3. if is_pair of first element of ast is true and the first element of - % first element of ast (ast[0][0]) is a symbol named "splice-unquote": - % return a new list containing: a symbol named "concat", the second element - % of first element of ast (ast[0][1]), and the result of calling quasiquote - % with the second through last element of ast. - {list, [{symbol, "concat"}, First] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote({T, [{symbol, "splice-unquote"}], _M}) when T == list orelse T == vector -> +qqLoop ({list, [{symbol, "splice-unquote"}, Arg], _Meta}, Acc) -> + {list, [{symbol, "concat"}, Arg, Acc], nil}; +qqLoop({list, [{symbol, "splice-unquote"}|_], _Meta}, _Acc) -> {error, "splice-unquote requires an argument"}; -quasiquote({T, [{symbol, "unquote"}, AST], _M}) when T == list orelse T == vector -> - % 2. else if the first element of ast is a symbol named "unquote": return - % the second element of ast. - AST; -quasiquote({T, [{symbol, "unquote"}|_], _M}) when T == list orelse T == vector -> - {error, "unquote expects one argument"}; -quasiquote({T, [First|Rest], _M}) when T == list orelse T == vector -> - % 4. otherwise: return a new list containing: a symbol named "cons", - % the result of calling quasiquote on first element of ast (ast[0]), - % and result of calling quasiquote with the second through last - % element of ast. - {list, [{symbol, "cons"}, quasiquote(First)] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote(AST) -> - % 1. if is_pair of ast is false: return a new list containing: - % a symbol named "quote" and ast. - {list, [{symbol, "quote"}, AST], nil}. +qqLoop(Elt, Acc) -> + {list, [{symbol, "cons"}, quasiquote(Elt), Acc], nil}. + +quasiquote({list, [{symbol, "unquote"}, Arg], _Meta}) -> + Arg; +quasiquote({list, [{symbol, "unquote"}|_], _Meta}) -> + error("unquote requires 1 argument"); +quasiquote({list, List, _Meta}) -> + lists:foldr(fun qqLoop/2, {list, [], nil}, List); +quasiquote({vector, List, _Meta}) -> + {list, [{symbol, "vec"}, lists:foldr(fun qqLoop/2, {list, [], nil}, List)], nil}; +quasiquote({symbol, _Symbol} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote({map, _Map, _Meta} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote(Arg) -> + Arg. is_macro_call({list, [{symbol, Name}|_], _Meta}, Env) -> case env:find(Env, {symbol, Name}) of diff --git a/impls/erlang/src/step9_try.erl b/impls/erlang/src/step9_try.erl index 1810843c..7bf67834 100644 --- a/impls/erlang/src/step9_try.erl +++ b/impls/erlang/src/step9_try.erl @@ -107,6 +107,10 @@ eval_list({list, [{symbol, "quote"}, AST], _Meta}, _Env) -> AST; eval_list({list, [{symbol, "quote"}|_], _Meta}, _Env) -> error("quote requires 1 argument"); +eval_list({list, [{symbol, "quasiquoteexpand"}, AST], _Meta}, Env) -> + quasiquote(AST); +eval_list({list, [{symbol, "quasiquoteexpand"}|_], _Meta}, _Env) -> + error("quasiquoteexpand requires 1 argument"); eval_list({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> eval(quasiquote(AST), Env); eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> @@ -199,31 +203,27 @@ list_to_proplist([_H], _AccIn) -> list_to_proplist([K,V|T], AccIn) -> list_to_proplist(T, [{K, V}|AccIn]). -quasiquote({T, [{list, [{symbol, "splice-unquote"}, First], _M1}|Rest], _M2}) when T == list orelse T == vector -> - % 3. if is_pair of first element of ast is true and the first element of - % first element of ast (ast[0][0]) is a symbol named "splice-unquote": - % return a new list containing: a symbol named "concat", the second element - % of first element of ast (ast[0][1]), and the result of calling quasiquote - % with the second through last element of ast. - {list, [{symbol, "concat"}, First] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote({T, [{symbol, "splice-unquote"}], _M}) when T == list orelse T == vector -> +qqLoop ({list, [{symbol, "splice-unquote"}, Arg], _Meta}, Acc) -> + {list, [{symbol, "concat"}, Arg, Acc], nil}; +qqLoop({list, [{symbol, "splice-unquote"}|_], _Meta}, _Acc) -> {error, "splice-unquote requires an argument"}; -quasiquote({T, [{symbol, "unquote"}, AST], _M}) when T == list orelse T == vector -> - % 2. else if the first element of ast is a symbol named "unquote": return - % the second element of ast. - AST; -quasiquote({T, [{symbol, "unquote"}|_], _M}) when T == list orelse T == vector -> - {error, "unquote expects one argument"}; -quasiquote({T, [First|Rest], _M}) when T == list orelse T == vector -> - % 4. otherwise: return a new list containing: a symbol named "cons", - % the result of calling quasiquote on first element of ast (ast[0]), - % and result of calling quasiquote with the second through last - % element of ast. - {list, [{symbol, "cons"}, quasiquote(First)] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote(AST) -> - % 1. if is_pair of ast is false: return a new list containing: - % a symbol named "quote" and ast. - {list, [{symbol, "quote"}, AST], nil}. +qqLoop(Elt, Acc) -> + {list, [{symbol, "cons"}, quasiquote(Elt), Acc], nil}. + +quasiquote({list, [{symbol, "unquote"}, Arg], _Meta}) -> + Arg; +quasiquote({list, [{symbol, "unquote"}|_], _Meta}) -> + error("unquote requires 1 argument"); +quasiquote({list, List, _Meta}) -> + lists:foldr(fun qqLoop/2, {list, [], nil}, List); +quasiquote({vector, List, _Meta}) -> + {list, [{symbol, "vec"}, lists:foldr(fun qqLoop/2, {list, [], nil}, List)], nil}; +quasiquote({symbol, _Symbol} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote({map, _Map, _Meta} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote(Arg) -> + Arg. is_macro_call({list, [{symbol, Name}|_], _Meta}, Env) -> case env:find(Env, {symbol, Name}) of diff --git a/impls/erlang/src/stepA_mal.erl b/impls/erlang/src/stepA_mal.erl index edf75247..4a32120c 100644 --- a/impls/erlang/src/stepA_mal.erl +++ b/impls/erlang/src/stepA_mal.erl @@ -109,6 +109,10 @@ eval_list({list, [{symbol, "quote"}, AST], _Meta}, _Env) -> AST; eval_list({list, [{symbol, "quote"}|_], _Meta}, _Env) -> error("quote requires 1 argument"); +eval_list({list, [{symbol, "quasiquoteexpand"}, AST], _Meta}, Env) -> + quasiquote(AST); +eval_list({list, [{symbol, "quasiquoteexpand"}|_], _Meta}, _Env) -> + error("quasiquoteexpand requires 1 argument"); eval_list({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> eval(quasiquote(AST), Env); eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> @@ -201,31 +205,27 @@ list_to_proplist([_H], _AccIn) -> list_to_proplist([K,V|T], AccIn) -> list_to_proplist(T, [{K, V}|AccIn]). -quasiquote({T, [{list, [{symbol, "splice-unquote"}, First], _M1}|Rest], _M2}) when T == list orelse T == vector -> - % 3. if is_pair of first element of ast is true and the first element of - % first element of ast (ast[0][0]) is a symbol named "splice-unquote": - % return a new list containing: a symbol named "concat", the second element - % of first element of ast (ast[0][1]), and the result of calling quasiquote - % with the second through last element of ast. - {list, [{symbol, "concat"}, First] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote({T, [{symbol, "splice-unquote"}], _M}) when T == list orelse T == vector -> +qqLoop ({list, [{symbol, "splice-unquote"}, Arg], _Meta}, Acc) -> + {list, [{symbol, "concat"}, Arg, Acc], nil}; +qqLoop({list, [{symbol, "splice-unquote"}|_], _Meta}, _Acc) -> {error, "splice-unquote requires an argument"}; -quasiquote({T, [{symbol, "unquote"}, AST], _M}) when T == list orelse T == vector -> - % 2. else if the first element of ast is a symbol named "unquote": return - % the second element of ast. - AST; -quasiquote({T, [{symbol, "unquote"}|_], _M}) when T == list orelse T == vector -> - {error, "unquote expects one argument"}; -quasiquote({T, [First|Rest], _M}) when T == list orelse T == vector -> - % 4. otherwise: return a new list containing: a symbol named "cons", - % the result of calling quasiquote on first element of ast (ast[0]), - % and result of calling quasiquote with the second through last - % element of ast. - {list, [{symbol, "cons"}, quasiquote(First)] ++ [quasiquote({list, Rest, nil})], nil}; -quasiquote(AST) -> - % 1. if is_pair of ast is false: return a new list containing: - % a symbol named "quote" and ast. - {list, [{symbol, "quote"}, AST], nil}. +qqLoop(Elt, Acc) -> + {list, [{symbol, "cons"}, quasiquote(Elt), Acc], nil}. + +quasiquote({list, [{symbol, "unquote"}, Arg], _Meta}) -> + Arg; +quasiquote({list, [{symbol, "unquote"}|_], _Meta}) -> + error("unquote requires 1 argument"); +quasiquote({list, List, _Meta}) -> + lists:foldr(fun qqLoop/2, {list, [], nil}, List); +quasiquote({vector, List, _Meta}) -> + {list, [{symbol, "vec"}, lists:foldr(fun qqLoop/2, {list, [], nil}, List)], nil}; +quasiquote({symbol, _Symbol} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote({map, _Map, _Meta} = Arg) -> + {list, [{symbol, "quote"}, Arg], nil}; +quasiquote(Arg) -> + Arg. is_macro_call({list, [{symbol, Name}|_], _Meta}, Env) -> case env:find(Env, {symbol, Name}) of diff --git a/impls/es6/core.mjs b/impls/es6/core.mjs index d99c3c5d..8a9af4a8 100644 --- a/impls/es6/core.mjs +++ b/impls/es6/core.mjs @@ -90,6 +90,7 @@ export const core_ns = new Map([ ['sequential?', a => Array.isArray(a)], ['cons', (a,b) => [a].concat(b)], ['concat', (...a) => a.reduce((x,y) => x.concat(y), [])], + ['vec', (a) => Vector.from(a)], ['nth', (a,b) => b < a.length ? a[b] : _error('nth: index out of range')], ['first', a => a !== null && a.length > 0 ? a[0] : null], ['rest', a => a === null ? [] : Array.from(a.slice(1))], diff --git a/impls/es6/step7_quote.mjs b/impls/es6/step7_quote.mjs index f0a6bdc7..0d11032a 100644 --- a/impls/es6/step7_quote.mjs +++ b/impls/es6/step7_quote.mjs @@ -1,6 +1,6 @@ import rl from './node_readline.js' const readline = rl.readline -import { _list_Q, _malfunc, _malfunc_Q } from './types' +import { _list_Q, _malfunc, _malfunc_Q, Vector } from './types' import { BlankException, read_str } from './reader' import { pr_str } from './printer' import { new_env, env_set, env_get } from './env' @@ -10,24 +10,29 @@ import { core_ns } from './core' const READ = str => read_str(str) // eval -const is_pair = x => Array.isArray(x) && x.length > 0 - -const quasiquote = ast => { - if (!is_pair(ast)) { - return [Symbol.for('quote'), ast] - } else if (ast[0] === Symbol.for('unquote')) { - return ast[1] - } else if (is_pair(ast[0]) && ast[0][0] === Symbol.for('splice-unquote')) { - return [Symbol.for('concat'), - ast[0][1], - quasiquote(ast.slice(1))] +const qq_loop = (acc, elt) => { + if (_list_Q(elt) && elt.length == 2 + && elt[0] === Symbol.for('splice-unquote')) { + return [Symbol.for('concat'), elt[1], acc] } else { - return [Symbol.for('cons'), - quasiquote(ast[0]), - quasiquote(ast.slice(1))] + return [Symbol.for('cons'), quasiquote (elt), acc] + } +} +const quasiquote = ast => { + if (_list_Q(ast)) { + if (ast.length == 2 && ast[0] === Symbol.for('unquote')) { + return ast[1] + } else { + return ast.reduceRight(qq_loop, []) + } + } else if (ast instanceof Vector) { + return [Symbol.for('vec'), ast.reduceRight(qq_loop, [])] + } else if (typeof ast === 'symbol' || ast instanceof Map) { + return [Symbol.for('quote'), ast] + } else { + return ast } } - const eval_ast = (ast, env) => { if (typeof ast === 'symbol') { return env_get(env, ast) @@ -62,6 +67,8 @@ const EVAL = (ast, env) => { break // continue TCO loop case 'quote': return a1 + case 'quasiquoteexpand': + return quasiquote(a1) case 'quasiquote': ast = quasiquote(a1) break // continue TCO loop diff --git a/impls/es6/step8_macros.mjs b/impls/es6/step8_macros.mjs index 454949ca..708b5ede 100644 --- a/impls/es6/step8_macros.mjs +++ b/impls/es6/step8_macros.mjs @@ -1,6 +1,6 @@ import rl from './node_readline.js' const readline = rl.readline -import { _clone, _list_Q, _malfunc, _malfunc_Q } from './types' +import { _clone, _list_Q, _malfunc, _malfunc_Q, Vector } from './types' import { BlankException, read_str } from './reader' import { pr_str } from './printer' import { new_env, env_set, env_get } from './env' @@ -10,21 +10,27 @@ import { core_ns } from './core' const READ = str => read_str(str) // eval -const is_pair = x => Array.isArray(x) && x.length > 0 - -const quasiquote = ast => { - if (!is_pair(ast)) { - return [Symbol.for('quote'), ast] - } else if (ast[0] === Symbol.for('unquote')) { - return ast[1] - } else if (is_pair(ast[0]) && ast[0][0] === Symbol.for('splice-unquote')) { - return [Symbol.for('concat'), - ast[0][1], - quasiquote(ast.slice(1))] +const qq_loop = (acc, elt) => { + if (_list_Q(elt) && elt.length == 2 + && elt[0] === Symbol.for('splice-unquote')) { + return [Symbol.for('concat'), elt[1], acc] } else { - return [Symbol.for('cons'), - quasiquote(ast[0]), - quasiquote(ast.slice(1))] + return [Symbol.for('cons'), quasiquote (elt), acc] + } +} +const quasiquote = ast => { + if (_list_Q(ast)) { + if (ast.length == 2 && ast[0] === Symbol.for('unquote')) { + return ast[1] + } else { + return ast.reduceRight(qq_loop, []) + } + } else if (ast instanceof Vector) { + return [Symbol.for('vec'), ast.reduceRight(qq_loop, [])] + } else if (typeof ast === 'symbol' || ast instanceof Map) { + return [Symbol.for('quote'), ast] + } else { + return ast } } @@ -75,6 +81,8 @@ const EVAL = (ast, env) => { break // continue TCO loop case 'quote': return a1 + case 'quasiquoteexpand': + return quasiquote(a1) case 'quasiquote': ast = quasiquote(a1) break // continue TCO loop diff --git a/impls/es6/step9_try.mjs b/impls/es6/step9_try.mjs index 5bc5e253..f0fd0c1d 100644 --- a/impls/es6/step9_try.mjs +++ b/impls/es6/step9_try.mjs @@ -1,6 +1,6 @@ import rl from './node_readline.js' const readline = rl.readline -import { _clone, _list_Q, _malfunc, _malfunc_Q } from './types' +import { _clone, _list_Q, _malfunc, _malfunc_Q, Vector } from './types' import { BlankException, read_str } from './reader' import { pr_str } from './printer' import { new_env, env_set, env_get } from './env' @@ -10,21 +10,27 @@ import { core_ns } from './core' const READ = str => read_str(str) // eval -const is_pair = x => Array.isArray(x) && x.length > 0 - -const quasiquote = ast => { - if (!is_pair(ast)) { - return [Symbol.for('quote'), ast] - } else if (ast[0] === Symbol.for('unquote')) { - return ast[1] - } else if (is_pair(ast[0]) && ast[0][0] === Symbol.for('splice-unquote')) { - return [Symbol.for('concat'), - ast[0][1], - quasiquote(ast.slice(1))] +const qq_loop = (acc, elt) => { + if (_list_Q(elt) && elt.length == 2 + && elt[0] === Symbol.for('splice-unquote')) { + return [Symbol.for('concat'), elt[1], acc] } else { - return [Symbol.for('cons'), - quasiquote(ast[0]), - quasiquote(ast.slice(1))] + return [Symbol.for('cons'), quasiquote (elt), acc] + } +} +const quasiquote = ast => { + if (_list_Q(ast)) { + if (ast.length == 2 && ast[0] === Symbol.for('unquote')) { + return ast[1] + } else { + return ast.reduceRight(qq_loop, []) + } + } else if (ast instanceof Vector) { + return [Symbol.for('vec'), ast.reduceRight(qq_loop, [])] + } else if (typeof ast === 'symbol' || ast instanceof Map) { + return [Symbol.for('quote'), ast] + } else { + return ast } } @@ -75,6 +81,8 @@ const EVAL = (ast, env) => { break // continue TCO loop case 'quote': return a1 + case 'quasiquoteexpand': + return quasiquote(a1) case 'quasiquote': ast = quasiquote(a1) break // continue TCO loop diff --git a/impls/es6/stepA_mal.mjs b/impls/es6/stepA_mal.mjs index 68eaa131..8f33c2d0 100644 --- a/impls/es6/stepA_mal.mjs +++ b/impls/es6/stepA_mal.mjs @@ -1,6 +1,6 @@ import rl from './node_readline.js' const readline = rl.readline -import { _clone, _list_Q, _malfunc, _malfunc_Q } from './types' +import { _clone, _list_Q, _malfunc, _malfunc_Q, Vector } from './types' import { BlankException, read_str } from './reader' import { pr_str } from './printer' import { new_env, env_set, env_get } from './env' @@ -10,21 +10,27 @@ import { core_ns } from './core' const READ = str => read_str(str) // eval -const is_pair = x => Array.isArray(x) && x.length > 0 - -const quasiquote = ast => { - if (!is_pair(ast)) { - return [Symbol.for('quote'), ast] - } else if (ast[0] === Symbol.for('unquote')) { - return ast[1] - } else if (is_pair(ast[0]) && ast[0][0] === Symbol.for('splice-unquote')) { - return [Symbol.for('concat'), - ast[0][1], - quasiquote(ast.slice(1))] +const qq_loop = (acc, elt) => { + if (_list_Q(elt) && elt.length == 2 + && elt[0] === Symbol.for('splice-unquote')) { + return [Symbol.for('concat'), elt[1], acc] } else { - return [Symbol.for('cons'), - quasiquote(ast[0]), - quasiquote(ast.slice(1))] + return [Symbol.for('cons'), quasiquote (elt), acc] + } +} +const quasiquote = ast => { + if (_list_Q(ast)) { + if (ast.length == 2 && ast[0] === Symbol.for('unquote')) { + return ast[1] + } else { + return ast.reduceRight(qq_loop, []) + } + } else if (ast instanceof Vector) { + return [Symbol.for('vec'), ast.reduceRight(qq_loop, [])] + } else if (typeof ast === 'symbol' || ast instanceof Map) { + return [Symbol.for('quote'), ast] + } else { + return ast } } @@ -75,6 +81,8 @@ const EVAL = (ast, env) => { break // continue TCO loop case 'quote': return a1 + case 'quasiquoteexpand': + return quasiquote(a1) case 'quasiquote': ast = quasiquote(a1) break // continue TCO loop diff --git a/impls/factor/lib/core/core.factor b/impls/factor/lib/core/core.factor index b51458b8..bbcbcf62 100644 --- a/impls/factor/lib/core/core.factor +++ b/impls/factor/lib/core/core.factor @@ -36,6 +36,7 @@ CONSTANT: ns H{ { "slurp" [ first utf8 file-contents ] } { "cons" [ first2 swap prefix { } like ] } { "concat" [ concat { } like ] } + { "vec" [ first >vector ] } { "nth" [ first2 swap nth ] } { "first" [ first dup nil? [ drop nil ] [ [ nil ] [ first ] if-empty ] if ] } { "rest" [ first dup nil? [ drop { } ] [ [ { } ] [ rest { } like ] if-empty ] if ] } diff --git a/impls/factor/step2_eval/step2_eval.factor b/impls/factor/step2_eval/step2_eval.factor index 2892911b..8b733331 100755 --- a/impls/factor/step2_eval/step2_eval.factor +++ b/impls/factor/step2_eval/step2_eval.factor @@ -14,22 +14,12 @@ CONSTANT: repl-env H{ DEFER: EVAL -: eval-symbol ( sym env -- ast ) +GENERIC# eval-ast 1 ( ast env -- ast ) +M: malsymbol eval-ast [ name>> ] dip ?at [ "no variable " prepend throw ] unless ; - -: eval-list ( list env -- ast ) - '[ _ EVAL ] map ; - -: eval-assoc ( assoc env -- ast ) - '[ [ _ EVAL ] bi@ ] assoc-map ; - -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ eval-symbol ] } - { [ over sequence? ] [ eval-list ] } - { [ over assoc? ] [ eval-assoc ] } - [ drop ] - } cond ; +M: sequence eval-ast '[ _ EVAL ] map ; +M: assoc eval-ast '[ _ EVAL ] assoc-map ; +M: object eval-ast drop ; : READ ( str -- maltype ) read-str ; diff --git a/impls/factor/step3_env/step3_env.factor b/impls/factor/step3_env/step3_env.factor index 310fea19..742c3f59 100755 --- a/impls/factor/step3_env/step3_env.factor +++ b/impls/factor/step3_env/step3_env.factor @@ -16,13 +16,11 @@ SYMBOL: repl-env DEFER: EVAL -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; +GENERIC# eval-ast 1 ( ast env -- ast ) +M: malsymbol eval-ast env-get ; +M: sequence eval-ast '[ _ EVAL ] map ; +M: assoc eval-ast '[ _ EVAL ] assoc-map ; +M: object eval-ast drop ; :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; diff --git a/impls/factor/step4_if_fn_do/step4_if_fn_do.factor b/impls/factor/step4_if_fn_do/step4_if_fn_do.factor index 6f51449e..37076e98 100755 --- a/impls/factor/step4_if_fn_do/step4_if_fn_do.factor +++ b/impls/factor/step4_if_fn_do/step4_if_fn_do.factor @@ -10,13 +10,11 @@ SYMBOL: repl-env DEFER: EVAL -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; +GENERIC# eval-ast 1 ( ast env -- ast ) +M: malsymbol eval-ast env-get ; +M: sequence eval-ast '[ _ EVAL ] map ; +M: assoc eval-ast '[ _ EVAL ] assoc-map ; +M: object eval-ast drop ; :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; diff --git a/impls/factor/step5_tco/step5_tco.factor b/impls/factor/step5_tco/step5_tco.factor index d14fbe9b..aff1b9cf 100755 --- a/impls/factor/step5_tco/step5_tco.factor +++ b/impls/factor/step5_tco/step5_tco.factor @@ -10,13 +10,11 @@ SYMBOL: repl-env DEFER: EVAL -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; +GENERIC# eval-ast 1 ( ast env -- ast ) +M: malsymbol eval-ast env-get ; +M: sequence eval-ast '[ _ EVAL ] map ; +M: assoc eval-ast '[ _ EVAL ] assoc-map ; +M: object eval-ast drop ; :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; diff --git a/impls/factor/step6_file/step6_file.factor b/impls/factor/step6_file/step6_file.factor index 9c0abe4b..290ee833 100755 --- a/impls/factor/step6_file/step6_file.factor +++ b/impls/factor/step6_file/step6_file.factor @@ -10,13 +10,11 @@ SYMBOL: repl-env DEFER: EVAL -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; +GENERIC# eval-ast 1 ( ast env -- ast ) +M: malsymbol eval-ast env-get ; +M: sequence eval-ast '[ _ EVAL ] map ; +M: assoc eval-ast '[ _ EVAL ] assoc-map ; +M: object eval-ast drop ; :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; diff --git a/impls/factor/step7_quote/step7_quote.factor b/impls/factor/step7_quote/step7_quote.factor index 8ebe3b2c..eae1cc5d 100755 --- a/impls/factor/step7_quote/step7_quote.factor +++ b/impls/factor/step7_quote/step7_quote.factor @@ -4,20 +4,18 @@ USING: accessors arrays assocs combinators combinators.short-circuit command-line continuations fry grouping hashtables io kernel lists locals lib.core lib.env lib.printer lib.reader lib.types math namespaces quotations -readline sequences splitting ; +readline sequences splitting vectors ; IN: step7_quote SYMBOL: repl-env DEFER: EVAL -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; +GENERIC# eval-ast 1 ( ast env -- ast ) +M: malsymbol eval-ast env-get ; +M: sequence eval-ast '[ _ EVAL ] map ; +M: assoc eval-ast '[ _ EVAL ] assoc-map ; +M: object eval-ast drop ; :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -51,7 +49,7 @@ DEFER: EVAL swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; -GENERIC: apply ( args fn -- maltype newenv/f ) +GENERIC# apply 0 ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] @@ -60,17 +58,36 @@ M: malfn apply M: callable apply call( x -- y ) f ; -: is-pair? ( maltype -- bool ) - { [ sequence? ] [ empty? not ] } 1&& ; +DEFER: quasiquote -: quasiquote ( maltype -- maltype ) - { - { [ dup is-pair? not ] [ [ "quote" ] dip 2array ] } - { [ "unquote" over first symeq? ] [ second ] } - { [ dup first { [ is-pair? ] [ first "splice-unquote" swap symeq? ] } 1&& ] - [ [ "concat" ] dip unclip second swap quasiquote 3array ] } - [ "cons" swap unclip quasiquote swap quasiquote 3array ] - } cond ; +: qq_loop ( elt acc -- maltype ) + [ + { [ dup array? ] + [ dup length 2 = ] + [ "splice-unquote" over first symeq? ] } 0&& [ + second "concat" + ] [ + quasiquote "cons" + ] if + swap + ] + dip 3array ; + +: qq_foldr ( xs -- maltype ) + dup length 0 = [ + drop { } + ] [ + unclip swap qq_foldr qq_loop + ] if ; + +GENERIC: quasiquote ( maltype -- maltype ) +M: array quasiquote + { [ dup length 2 = ] [ "unquote" over first symeq? ] } 0&& + [ second ] [ qq_foldr ] if ; +M: vector quasiquote qq_foldr "vec" swap 2array ; +M: malsymbol quasiquote "quote" swap 2array ; +M: assoc quasiquote "quote" swap 2array ; +M: object quasiquote ; : READ ( str -- maltype ) read-str ; @@ -78,11 +95,12 @@ M: callable apply call( x -- y ) f ; over { [ array? ] [ empty? not ] } 1&& [ over first dup malsymbol? [ name>> ] when { { "def!" [ [ rest first2 ] dip eval-def! f ] } - { "let*" [ [ first2 ] dip eval-let* ] } + { "let*" [ [ rest first2 ] dip eval-let* ] } { "do" [ [ rest ] dip eval-do ] } { "if" [ [ rest ] dip eval-if ] } { "fn*" [ [ rest ] dip eval-fn* f ] } { "quote" [ drop second f ] } + { "quasiquoteexpand" [ drop second quasiquote f ] } { "quasiquote" [ [ second quasiquote ] dip ] } [ drop '[ _ EVAL ] map unclip apply ] } case [ EVAL ] when* diff --git a/impls/factor/step8_macros/step8_macros.factor b/impls/factor/step8_macros/step8_macros.factor index 8a251e35..ef4bd070 100755 --- a/impls/factor/step8_macros/step8_macros.factor +++ b/impls/factor/step8_macros/step8_macros.factor @@ -4,20 +4,18 @@ USING: accessors arrays assocs combinators combinators.short-circuit command-line continuations fry grouping hashtables io kernel lists locals lib.core lib.env lib.printer lib.reader lib.types math namespaces quotations -readline sequences splitting ; +readline sequences splitting vectors ; IN: step8_macros SYMBOL: repl-env DEFER: EVAL -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; +GENERIC# eval-ast 1 ( ast env -- ast ) +M: malsymbol eval-ast env-get ; +M: sequence eval-ast '[ _ EVAL ] map ; +M: assoc eval-ast '[ _ EVAL ] assoc-map ; +M: object eval-ast drop ; :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -54,7 +52,7 @@ DEFER: EVAL swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; -GENERIC: apply ( args fn -- maltype newenv/f ) +GENERIC# apply 0 ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] @@ -63,17 +61,36 @@ M: malfn apply M: callable apply call( x -- y ) f ; -: is-pair? ( maltype -- bool ) - { [ sequence? ] [ empty? not ] } 1&& ; +DEFER: quasiquote -: quasiquote ( maltype -- maltype ) - { - { [ dup is-pair? not ] [ [ "quote" ] dip 2array ] } - { [ "unquote" over first symeq? ] [ second ] } - { [ dup first { [ is-pair? ] [ first "splice-unquote" swap symeq? ] } 1&& ] - [ [ "concat" ] dip unclip second swap quasiquote 3array ] } - [ "cons" swap unclip swap [ quasiquote ] bi@ 3array ] - } cond ; +: qq_loop ( elt acc -- maltype ) + [ + { [ dup array? ] + [ dup length 2 = ] + [ "splice-unquote" over first symeq? ] } 0&& [ + second "concat" + ] [ + quasiquote "cons" + ] if + swap + ] + dip 3array ; + +: qq_foldr ( xs -- maltype ) + dup length 0 = [ + drop { } + ] [ + unclip swap qq_foldr qq_loop + ] if ; + +GENERIC: quasiquote ( maltype -- maltype ) +M: array quasiquote + { [ dup length 2 = ] [ "unquote" over first symeq? ] } 0&& + [ second ] [ qq_foldr ] if ; +M: vector quasiquote qq_foldr "vec" swap 2array ; +M: malsymbol quasiquote "quote" swap 2array ; +M: assoc quasiquote "quote" swap 2array ; +M: object quasiquote ; :: macro-expand ( maltype env -- maltype ) maltype dup array? [ @@ -97,6 +114,7 @@ M: callable apply call( x -- y ) f ; { "if" [ [ rest ] dip eval-if ] } { "fn*" [ [ rest ] dip eval-fn* f ] } { "quote" [ drop second f ] } + { "quasiquoteexpand" [ drop second quasiquote f ] } { "quasiquote" [ [ second quasiquote ] dip ] } { "macroexpand" [ [ second ] dip macro-expand f ] } [ drop '[ _ EVAL ] map unclip apply ] diff --git a/impls/factor/step9_try/step9_try.factor b/impls/factor/step9_try/step9_try.factor index 877a3016..490d1e37 100755 --- a/impls/factor/step9_try/step9_try.factor +++ b/impls/factor/step9_try/step9_try.factor @@ -4,20 +4,18 @@ USING: accessors arrays assocs combinators combinators.short-circuit command-line continuations fry grouping hashtables io kernel lists locals lib.core lib.env lib.printer lib.reader lib.types math namespaces quotations -readline sequences splitting ; +readline sequences splitting vectors ; IN: step9_try SYMBOL: repl-env DEFER: EVAL -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; +GENERIC# eval-ast 1 ( ast env -- ast ) +M: malsymbol eval-ast env-get ; +M: sequence eval-ast '[ _ EVAL ] map ; +M: assoc eval-ast '[ _ EVAL ] assoc-map ; +M: object eval-ast drop ; :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -65,7 +63,7 @@ DEFER: EVAL swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; -GENERIC: apply ( args fn -- maltype newenv/f ) +GENERIC# apply 0 ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] @@ -74,17 +72,36 @@ M: malfn apply M: callable apply call( x -- y ) f ; -: is-pair? ( maltype -- bool ) - { [ sequence? ] [ empty? not ] } 1&& ; +DEFER: quasiquote -: quasiquote ( maltype -- maltype ) - { - { [ dup is-pair? not ] [ [ "quote" ] dip 2array ] } - { [ "unquote" over first symeq? ] [ second ] } - { [ dup first { [ is-pair? ] [ first "splice-unquote" swap symeq? ] } 1&& ] - [ [ "concat" ] dip unclip second swap quasiquote 3array ] } - [ "cons" swap unclip swap [ quasiquote ] bi@ 3array ] - } cond ; +: qq_loop ( elt acc -- maltype ) + [ + { [ dup array? ] + [ dup length 2 = ] + [ "splice-unquote" over first symeq? ] } 0&& [ + second "concat" + ] [ + quasiquote "cons" + ] if + swap + ] + dip 3array ; + +: qq_foldr ( xs -- maltype ) + dup length 0 = [ + drop { } + ] [ + unclip swap qq_foldr qq_loop + ] if ; + +GENERIC: quasiquote ( maltype -- maltype ) +M: array quasiquote + { [ dup length 2 = ] [ "unquote" over first symeq? ] } 0&& + [ second ] [ qq_foldr ] if ; +M: vector quasiquote qq_foldr "vec" swap 2array ; +M: malsymbol quasiquote "quote" swap 2array ; +M: assoc quasiquote "quote" swap 2array ; +M: object quasiquote ; :: macro-expand ( maltype env -- maltype ) maltype dup array? [ @@ -108,6 +125,7 @@ M: callable apply call( x -- y ) f ; { "if" [ [ rest ] dip eval-if ] } { "fn*" [ [ rest ] dip eval-fn* f ] } { "quote" [ drop second f ] } + { "quasiquoteexpand" [ drop second quasiquote f ] } { "quasiquote" [ [ second quasiquote ] dip ] } { "macroexpand" [ [ second ] dip macro-expand f ] } { "try*" [ [ rest ] dip eval-try* f ] } diff --git a/impls/factor/stepA_mal/stepA_mal.factor b/impls/factor/stepA_mal/stepA_mal.factor index d95ee884..438111f5 100755 --- a/impls/factor/stepA_mal/stepA_mal.factor +++ b/impls/factor/stepA_mal/stepA_mal.factor @@ -4,20 +4,18 @@ USING: accessors arrays assocs combinators combinators.short-circuit command-line continuations fry grouping hashtables io kernel lists locals lib.core lib.env lib.printer lib.reader lib.types math namespaces quotations -readline sequences splitting strings ; +readline sequences splitting strings vectors ; IN: stepA_mal SYMBOL: repl-env DEFER: EVAL -: eval-ast ( ast env -- ast ) - { - { [ over malsymbol? ] [ env-get ] } - { [ over sequence? ] [ '[ _ EVAL ] map ] } - { [ over assoc? ] [ '[ [ _ EVAL ] bi@ ] assoc-map ] } - [ drop ] - } cond ; +GENERIC# eval-ast 1 ( ast env -- ast ) +M: malsymbol eval-ast env-get ; +M: sequence eval-ast '[ _ EVAL ] map ; +M: assoc eval-ast '[ _ EVAL ] assoc-map ; +M: object eval-ast drop ; :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -65,7 +63,7 @@ DEFER: EVAL swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; -GENERIC: apply ( args fn -- maltype newenv/f ) +GENERIC# apply 0 ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] @@ -74,17 +72,36 @@ M: malfn apply M: callable apply call( x -- y ) f ; -: is-pair? ( maltype -- ? ) - { [ sequence? ] [ string? not ] [ empty? not ] } 1&& ; +DEFER: quasiquote -: quasiquote ( maltype -- maltype ) - { - { [ dup is-pair? not ] [ [ "quote" ] dip 2array ] } - { [ "unquote" over first symeq? ] [ second ] } - { [ dup first { [ is-pair? ] [ first "splice-unquote" swap symeq? ] } 1&& ] - [ [ "concat" ] dip unclip second swap quasiquote 3array ] } - [ "cons" swap unclip swap [ quasiquote ] bi@ 3array ] - } cond ; +: qq_loop ( elt acc -- maltype ) + [ + { [ dup array? ] + [ dup length 2 = ] + [ "splice-unquote" over first symeq? ] } 0&& [ + second "concat" + ] [ + quasiquote "cons" + ] if + swap + ] + dip 3array ; + +: qq_foldr ( xs -- maltype ) + dup length 0 = [ + drop { } + ] [ + unclip swap qq_foldr qq_loop + ] if ; + +GENERIC: quasiquote ( maltype -- maltype ) +M: array quasiquote + { [ dup length 2 = ] [ "unquote" over first symeq? ] } 0&& + [ second ] [ qq_foldr ] if ; +M: vector quasiquote qq_foldr "vec" swap 2array ; +M: malsymbol quasiquote "quote" swap 2array ; +M: assoc quasiquote "quote" swap 2array ; +M: object quasiquote ; :: macro-expand ( maltype env -- maltype ) maltype dup array? [ @@ -108,6 +125,7 @@ M: callable apply call( x -- y ) f ; { "if" [ [ rest ] dip eval-if ] } { "fn*" [ [ rest ] dip eval-fn* f ] } { "quote" [ drop second f ] } + { "quasiquoteexpand" [ drop second quasiquote f ] } { "quasiquote" [ [ second quasiquote ] dip ] } { "macroexpand" [ [ second ] dip macro-expand f ] } { "try*" [ [ rest ] dip eval-try* f ] } diff --git a/impls/fantom/src/mallib/fan/core.fan b/impls/fantom/src/mallib/fan/core.fan index 4331db4c..6559a481 100644 --- a/impls/fantom/src/mallib/fan/core.fan +++ b/impls/fantom/src/mallib/fan/core.fan @@ -92,6 +92,7 @@ class Core "sequential?": MalFunc { MalTypes.toMalBool(it[0] is MalSeq) }, "cons": MalFunc { MalList([it[0]].addAll((it[1] as MalSeq).value)) }, "concat": MalFunc(#concat.func), + "vec": MalFunc { MalVector((it[0] as MalSeq).value) }, "nth": MalFunc { (it[0] as MalSeq).nth((it[1] as MalInteger).value) }, "first": MalFunc { (it[0] as MalSeq)?.first ?: MalNil.INSTANCE }, "rest": MalFunc { (it[0] as MalSeq)?.rest ?: MalList([,]) }, diff --git a/impls/fantom/src/step7_quote/fan/main.fan b/impls/fantom/src/step7_quote/fan/main.fan index a61976f3..080591c8 100644 --- a/impls/fantom/src/step7_quote/fan/main.fan +++ b/impls/fantom/src/step7_quote/fan/main.fan @@ -2,20 +2,43 @@ using mallib class Main { + + static MalList qq_loop(MalVal elt, MalList acc) + { + lst := elt as MalList + if (lst?.count == 2 && (lst[0] as MalSymbol)?.value == "splice-unquote") + return MalList(MalVal[MalSymbol("concat"), lst[1], acc]) + else + return MalList(MalVal[MalSymbol("cons"), quasiquote(elt), acc]) + } + + static MalList qq_foldr(MalSeq xs) + { + acc := MalList([,]) + for (i:=xs.count-1; 0<=i; i-=1) + acc = qq_loop(xs[i], acc) + return acc + } + static MalVal quasiquote(MalVal ast) { - if (!MalTypes.isPair(ast)) - return MalList(MalVal[MalSymbol("quote"), ast]) - astSeq := ast as MalSeq - if ((astSeq[0] as MalSymbol)?.value == "unquote") - return astSeq[1] - if (MalTypes.isPair(astSeq[0])) + switch (ast.typeof) { - ast0Seq := astSeq[0] as MalSeq - if ((ast0Seq[0] as MalSymbol)?.value == "splice-unquote") - return MalList(MalVal[MalSymbol("concat"), ast0Seq[1], quasiquote(astSeq.drop(1))]) + case MalList#: + lst := ast as MalList + if (lst.count == 2 && (lst[0] as MalSymbol)?.value == "unquote") + return lst[1] + else + return qq_foldr((MalSeq)ast) + case MalVector#: + return MalList(MalVal[MalSymbol("vec"), qq_foldr((MalSeq)ast)]) + case MalSymbol#: + return MalList(MalVal[MalSymbol("quote"), ast]) + case MalHashMap#: + return MalList(MalVal[MalSymbol("quote"), ast]) + default: + return ast } - return MalList(MalVal[MalSymbol("cons"), quasiquote(astSeq[0]), quasiquote(astSeq.drop(1))]) } static MalVal READ(Str s) @@ -64,6 +87,8 @@ class Main // TCO case "quote": return astList[1] + case "quasiquoteexpand": + return quasiquote(astList[1]) case "quasiquote": ast = quasiquote(astList[1]) // TCO diff --git a/impls/fantom/src/step8_macros/fan/main.fan b/impls/fantom/src/step8_macros/fan/main.fan index ab2d2bff..418ddd66 100644 --- a/impls/fantom/src/step8_macros/fan/main.fan +++ b/impls/fantom/src/step8_macros/fan/main.fan @@ -2,20 +2,43 @@ using mallib class Main { + + static MalList qq_loop(MalVal elt, MalList acc) + { + lst := elt as MalList + if (lst?.count == 2 && (lst[0] as MalSymbol)?.value == "splice-unquote") + return MalList(MalVal[MalSymbol("concat"), lst[1], acc]) + else + return MalList(MalVal[MalSymbol("cons"), quasiquote(elt), acc]) + } + + static MalList qq_foldr(MalSeq xs) + { + acc := MalList([,]) + for (i:=xs.count-1; 0<=i; i-=1) + acc = qq_loop(xs[i], acc) + return acc + } + static MalVal quasiquote(MalVal ast) { - if (!MalTypes.isPair(ast)) - return MalList(MalVal[MalSymbol("quote"), ast]) - astSeq := ast as MalSeq - if ((astSeq[0] as MalSymbol)?.value == "unquote") - return astSeq[1] - if (MalTypes.isPair(astSeq[0])) + switch (ast.typeof) { - ast0Seq := astSeq[0] as MalSeq - if ((ast0Seq[0] as MalSymbol)?.value == "splice-unquote") - return MalList(MalVal[MalSymbol("concat"), ast0Seq[1], quasiquote(astSeq.drop(1))]) + case MalList#: + lst := ast as MalList + if (lst.count == 2 && (lst[0] as MalSymbol)?.value == "unquote") + return lst[1] + else + return qq_foldr((MalSeq)ast) + case MalVector#: + return MalList(MalVal[MalSymbol("vec"), qq_foldr((MalSeq)ast)]) + case MalSymbol#: + return MalList(MalVal[MalSymbol("quote"), ast]) + case MalHashMap#: + return MalList(MalVal[MalSymbol("quote"), ast]) + default: + return ast } - return MalList(MalVal[MalSymbol("cons"), quasiquote(astSeq[0]), quasiquote(astSeq.drop(1))]) } static Bool isMacroCall(MalVal ast, MalEnv env) @@ -87,6 +110,8 @@ class Main // TCO case "quote": return astList[1] + case "quasiquoteexpand": + return quasiquote(astList[1]) case "quasiquote": ast = quasiquote(astList[1]) // TCO diff --git a/impls/fantom/src/step9_try/fan/main.fan b/impls/fantom/src/step9_try/fan/main.fan index 58b29123..848df6f0 100644 --- a/impls/fantom/src/step9_try/fan/main.fan +++ b/impls/fantom/src/step9_try/fan/main.fan @@ -2,20 +2,43 @@ using mallib class Main { + + static MalList qq_loop(MalVal elt, MalList acc) + { + lst := elt as MalList + if (lst?.count == 2 && (lst[0] as MalSymbol)?.value == "splice-unquote") + return MalList(MalVal[MalSymbol("concat"), lst[1], acc]) + else + return MalList(MalVal[MalSymbol("cons"), quasiquote(elt), acc]) + } + + static MalList qq_foldr(MalSeq xs) + { + acc := MalList([,]) + for (i:=xs.count-1; 0<=i; i-=1) + acc = qq_loop(xs[i], acc) + return acc + } + static MalVal quasiquote(MalVal ast) { - if (!MalTypes.isPair(ast)) - return MalList(MalVal[MalSymbol("quote"), ast]) - astSeq := ast as MalSeq - if ((astSeq[0] as MalSymbol)?.value == "unquote") - return astSeq[1] - if (MalTypes.isPair(astSeq[0])) + switch (ast.typeof) { - ast0Seq := astSeq[0] as MalSeq - if ((ast0Seq[0] as MalSymbol)?.value == "splice-unquote") - return MalList(MalVal[MalSymbol("concat"), ast0Seq[1], quasiquote(astSeq.drop(1))]) + case MalList#: + lst := ast as MalList + if (lst.count == 2 && (lst[0] as MalSymbol)?.value == "unquote") + return lst[1] + else + return qq_foldr((MalSeq)ast) + case MalVector#: + return MalList(MalVal[MalSymbol("vec"), qq_foldr((MalSeq)ast)]) + case MalSymbol#: + return MalList(MalVal[MalSymbol("quote"), ast]) + case MalHashMap#: + return MalList(MalVal[MalSymbol("quote"), ast]) + default: + return ast } - return MalList(MalVal[MalSymbol("cons"), quasiquote(astSeq[0]), quasiquote(astSeq.drop(1))]) } static Bool isMacroCall(MalVal ast, MalEnv env) @@ -87,6 +110,8 @@ class Main // TCO case "quote": return astList[1] + case "quasiquoteexpand": + return quasiquote(astList[1]) case "quasiquote": ast = quasiquote(astList[1]) // TCO diff --git a/impls/fantom/src/stepA_mal/fan/main.fan b/impls/fantom/src/stepA_mal/fan/main.fan index 5b4c49a8..d58696d8 100644 --- a/impls/fantom/src/stepA_mal/fan/main.fan +++ b/impls/fantom/src/stepA_mal/fan/main.fan @@ -2,20 +2,43 @@ using mallib class Main { + + static MalList qq_loop(MalVal elt, MalList acc) + { + lst := elt as MalList + if (lst?.count == 2 && (lst[0] as MalSymbol)?.value == "splice-unquote") + return MalList(MalVal[MalSymbol("concat"), lst[1], acc]) + else + return MalList(MalVal[MalSymbol("cons"), quasiquote(elt), acc]) + } + + static MalList qq_foldr(MalSeq xs) + { + acc := MalList([,]) + for (i:=xs.count-1; 0<=i; i-=1) + acc = qq_loop(xs[i], acc) + return acc + } + static MalVal quasiquote(MalVal ast) { - if (!MalTypes.isPair(ast)) - return MalList(MalVal[MalSymbol("quote"), ast]) - astSeq := ast as MalSeq - if ((astSeq[0] as MalSymbol)?.value == "unquote") - return astSeq[1] - if (MalTypes.isPair(astSeq[0])) + switch (ast.typeof) { - ast0Seq := astSeq[0] as MalSeq - if ((ast0Seq[0] as MalSymbol)?.value == "splice-unquote") - return MalList(MalVal[MalSymbol("concat"), ast0Seq[1], quasiquote(astSeq.drop(1))]) + case MalList#: + lst := ast as MalList + if (lst.count == 2 && (lst[0] as MalSymbol)?.value == "unquote") + return lst[1] + else + return qq_foldr((MalSeq)ast) + case MalVector#: + return MalList(MalVal[MalSymbol("vec"), qq_foldr((MalSeq)ast)]) + case MalSymbol#: + return MalList(MalVal[MalSymbol("quote"), ast]) + case MalHashMap#: + return MalList(MalVal[MalSymbol("quote"), ast]) + default: + return ast } - return MalList(MalVal[MalSymbol("cons"), quasiquote(astSeq[0]), quasiquote(astSeq.drop(1))]) } static Bool isMacroCall(MalVal ast, MalEnv env) @@ -87,6 +110,8 @@ class Main // TCO case "quote": return astList[1] + case "quasiquoteexpand": + return quasiquote(astList[1]) case "quasiquote": ast = quasiquote(astList[1]) // TCO diff --git a/impls/forth/core.fs b/impls/forth/core.fs index 896d154e..9015f4a3 100644 --- a/impls/forth/core.fs +++ b/impls/forth/core.fs @@ -86,6 +86,13 @@ defcore concat { lists argc } argc over MalList/count ! MalList/concat ;; +defcore vec ( argv[coll] argc ) + drop + @ + dup mal-type @ MalList = if + MalVector new tuck MalVector/list ! + endif ;; + defcore conj { argv argc } argv @ ( coll ) argc 1 ?do diff --git a/impls/forth/step7_quote.fs b/impls/forth/step7_quote.fs index 5286d503..3198ef33 100644 --- a/impls/forth/step7_quote.fs +++ b/impls/forth/step7_quote.fs @@ -67,47 +67,74 @@ drop :noname ; -: is-pair? ( obj -- bool ) - empty? mal-false = ; - defspecial quote ( env list -- form ) nip MalList/start @ cell+ @ ;; s" concat" MalSymbol. constant concat-sym s" cons" MalSymbol. constant cons-sym +s" vec" MalSymbol. constant vec-sym defer quasiquote -: quasiquote0 { ast -- form } - ast is-pair? 0= if - here quote-sym , ast , here>MalList - else - ast to-list MalList/start @ { ast-start } - ast-start @ { ast[0] } - ast[0] unquote-sym m= if - ast-start cell+ @ - else - ast[0] is-pair? if - ast[0] to-list MalList/start @ { ast[0]-start } - ast[0]-start @ splice-unquote-sym m= if - here - concat-sym , - ast[0]-start cell+ @ , - ast to-list MalList/rest quasiquote , - here>MalList - false - else true endif - else true endif - if - here - cons-sym , - ast[0] quasiquote , - ast to-list MalList/rest quasiquote , - here>MalList - endif + +( If the list has two elements and the first is sym, return the second ) +( element and true, else return the list unchanged and false. ) +: qq_extract_unquote ( list symbol -- form f ) + over MalList/count @ 2 = if + over MalList/start @ tuck @ m= if ( list start - ) + cell+ @ + nip + true + exit endif + endif + drop + false ; + +( Transition function for the following quasiquote folder. ) +: qq_loop ( acc elt -- form ) + dup mal-type @ MalList = if + splice-unquote-sym qq_extract_unquote if + here concat-sym , swap , swap , here>MalList + exit + endif + endif + quasiquote + here cons-sym , swap , swap , here>MalList ; + +( Right-fold quasiquoting each element of a list. ) +: qq_foldr ( list -- form ) + dup MalList/count @ if + dup MalList/rest recurse + swap MalList/start @ @ + qq_loop endif ; + +: quasiquote0 ( ast -- form ) + dup mal-type @ case + MalList of + unquote-sym qq_extract_unquote if + ( the work is already done ) + else + qq_foldr + endif + endof + MalVector of + MalVector/list @ qq_foldr + here vec-sym , swap , here>MalList + endof + MalSymbol of + here quote-sym , swap , here>MalList + endof + MalMap of + here quote-sym , swap , here>MalList + endof + ( other types are returned unchanged ) + endcase ; ' quasiquote0 is quasiquote +defspecial quasiquoteexpand ( env list -- form ) + nip MalList/start @ cell+ @ quasiquote ;; + defspecial quasiquote ( env list ) MalList/start @ cell+ @ ( ast ) quasiquote TCO-eval ;; diff --git a/impls/forth/step8_macros.fs b/impls/forth/step8_macros.fs index 202b3775..0ea32523 100644 --- a/impls/forth/step8_macros.fs +++ b/impls/forth/step8_macros.fs @@ -67,47 +67,74 @@ drop :noname ; -: is-pair? ( obj -- bool ) - empty? mal-false = ; - defspecial quote ( env list -- form ) nip MalList/start @ cell+ @ ;; s" concat" MalSymbol. constant concat-sym s" cons" MalSymbol. constant cons-sym +s" vec" MalSymbol. constant vec-sym defer quasiquote -: quasiquote0 { ast -- form } - ast is-pair? 0= if - here quote-sym , ast , here>MalList - else - ast to-list MalList/start @ { ast-start } - ast-start @ { ast[0] } - ast[0] unquote-sym m= if - ast-start cell+ @ - else - ast[0] is-pair? if - ast[0] to-list MalList/start @ { ast[0]-start } - ast[0]-start @ splice-unquote-sym m= if - here - concat-sym , - ast[0]-start cell+ @ , - ast to-list MalList/rest quasiquote , - here>MalList - false - else true endif - else true endif - if - here - cons-sym , - ast[0] quasiquote , - ast to-list MalList/rest quasiquote , - here>MalList - endif + +( If the list has two elements and the first is sym, return the second ) +( element and true, else return the list unchanged and false. ) +: qq_extract_unquote ( list symbol -- form f ) + over MalList/count @ 2 = if + over MalList/start @ tuck @ m= if ( list start - ) + cell+ @ + nip + true + exit endif + endif + drop + false ; + +( Transition function for the following quasiquote folder. ) +: qq_loop ( acc elt -- form ) + dup mal-type @ MalList = if + splice-unquote-sym qq_extract_unquote if + here concat-sym , swap , swap , here>MalList + exit + endif + endif + quasiquote + here cons-sym , swap , swap , here>MalList ; + +( Right-fold quasiquoting each element of a list. ) +: qq_foldr ( list -- form ) + dup MalList/count @ if + dup MalList/rest recurse + swap MalList/start @ @ + qq_loop endif ; + +: quasiquote0 ( ast -- form ) + dup mal-type @ case + MalList of + unquote-sym qq_extract_unquote if + ( the work is already done ) + else + qq_foldr + endif + endof + MalVector of + MalVector/list @ qq_foldr + here vec-sym , swap , here>MalList + endof + MalSymbol of + here quote-sym , swap , here>MalList + endof + MalMap of + here quote-sym , swap , here>MalList + endof + ( other types are returned unchanged ) + endcase ; ' quasiquote0 is quasiquote +defspecial quasiquoteexpand ( env list -- form ) + nip MalList/start @ cell+ @ quasiquote ;; + defspecial quasiquote ( env list ) MalList/start @ cell+ @ ( ast ) quasiquote TCO-eval ;; diff --git a/impls/forth/step9_try.fs b/impls/forth/step9_try.fs index 435392be..ab39fd56 100644 --- a/impls/forth/step9_try.fs +++ b/impls/forth/step9_try.fs @@ -76,47 +76,74 @@ drop :noname ; -: is-pair? ( obj -- bool ) - empty? mal-false = ; - defspecial quote ( env list -- form ) nip MalList/start @ cell+ @ ;; s" concat" MalSymbol. constant concat-sym s" cons" MalSymbol. constant cons-sym +s" vec" MalSymbol. constant vec-sym defer quasiquote -: quasiquote0 { ast -- form } - ast is-pair? 0= if - here quote-sym , ast , here>MalList - else - ast to-list MalList/start @ { ast-start } - ast-start @ { ast[0] } - ast[0] unquote-sym m= if - ast-start cell+ @ - else - ast[0] is-pair? if - ast[0] to-list MalList/start @ { ast[0]-start } - ast[0]-start @ splice-unquote-sym m= if - here - concat-sym , - ast[0]-start cell+ @ , - ast to-list MalList/rest quasiquote , - here>MalList - false - else true endif - else true endif - if - here - cons-sym , - ast[0] quasiquote , - ast to-list MalList/rest quasiquote , - here>MalList - endif + +( If the list has two elements and the first is sym, return the second ) +( element and true, else return the list unchanged and false. ) +: qq_extract_unquote ( list symbol -- form f ) + over MalList/count @ 2 = if + over MalList/start @ tuck @ m= if ( list start - ) + cell+ @ + nip + true + exit endif + endif + drop + false ; + +( Transition function for the following quasiquote folder. ) +: qq_loop ( acc elt -- form ) + dup mal-type @ MalList = if + splice-unquote-sym qq_extract_unquote if + here concat-sym , swap , swap , here>MalList + exit + endif + endif + quasiquote + here cons-sym , swap , swap , here>MalList ; + +( Right-fold quasiquoting each element of a list. ) +: qq_foldr ( list -- form ) + dup MalList/count @ if + dup MalList/rest recurse + swap MalList/start @ @ + qq_loop endif ; + +: quasiquote0 ( ast -- form ) + dup mal-type @ case + MalList of + unquote-sym qq_extract_unquote if + ( the work is already done ) + else + qq_foldr + endif + endof + MalVector of + MalVector/list @ qq_foldr + here vec-sym , swap , here>MalList + endof + MalSymbol of + here quote-sym , swap , here>MalList + endof + MalMap of + here quote-sym , swap , here>MalList + endof + ( other types are returned unchanged ) + endcase ; ' quasiquote0 is quasiquote +defspecial quasiquoteexpand ( env list -- form ) + nip MalList/start @ cell+ @ quasiquote ;; + defspecial quasiquote ( env list ) MalList/start @ cell+ @ ( ast ) quasiquote TCO-eval ;; diff --git a/impls/forth/stepA_mal.fs b/impls/forth/stepA_mal.fs index 0aa7e107..bcf08ff4 100644 --- a/impls/forth/stepA_mal.fs +++ b/impls/forth/stepA_mal.fs @@ -76,47 +76,74 @@ drop :noname ; -: is-pair? ( obj -- bool ) - empty? mal-false = ; - defspecial quote ( env list -- form ) nip MalList/start @ cell+ @ ;; s" concat" MalSymbol. constant concat-sym s" cons" MalSymbol. constant cons-sym +s" vec" MalSymbol. constant vec-sym defer quasiquote -: quasiquote0 { ast -- form } - ast is-pair? 0= if - here quote-sym , ast , here>MalList - else - ast to-list MalList/start @ { ast-start } - ast-start @ { ast[0] } - ast[0] unquote-sym m= if - ast-start cell+ @ - else - ast[0] is-pair? if - ast[0] to-list MalList/start @ { ast[0]-start } - ast[0]-start @ splice-unquote-sym m= if - here - concat-sym , - ast[0]-start cell+ @ , - ast to-list MalList/rest quasiquote , - here>MalList - false - else true endif - else true endif - if - here - cons-sym , - ast[0] quasiquote , - ast to-list MalList/rest quasiquote , - here>MalList - endif + +( If the list has two elements and the first is sym, return the second ) +( element and true, else return the list unchanged and false. ) +: qq_extract_unquote ( list symbol -- form f ) + over MalList/count @ 2 = if + over MalList/start @ tuck @ m= if ( list start - ) + cell+ @ + nip + true + exit endif + endif + drop + false ; + +( Transition function for the following quasiquote folder. ) +: qq_loop ( acc elt -- form ) + dup mal-type @ MalList = if + splice-unquote-sym qq_extract_unquote if + here concat-sym , swap , swap , here>MalList + exit + endif + endif + quasiquote + here cons-sym , swap , swap , here>MalList ; + +( Right-fold quasiquoting each element of a list. ) +: qq_foldr ( list -- form ) + dup MalList/count @ if + dup MalList/rest recurse + swap MalList/start @ @ + qq_loop endif ; + +: quasiquote0 ( ast -- form ) + dup mal-type @ case + MalList of + unquote-sym qq_extract_unquote if + ( the work is already done ) + else + qq_foldr + endif + endof + MalVector of + MalVector/list @ qq_foldr + here vec-sym , swap , here>MalList + endof + MalSymbol of + here quote-sym , swap , here>MalList + endof + MalMap of + here quote-sym , swap , here>MalList + endof + ( other types are returned unchanged ) + endcase ; ' quasiquote0 is quasiquote +defspecial quasiquoteexpand ( env list -- form ) + nip MalList/start @ cell+ @ quasiquote ;; + defspecial quasiquote ( env list ) MalList/start @ cell+ @ ( ast ) quasiquote TCO-eval ;; diff --git a/impls/fsharp/core.fs b/impls/fsharp/core.fs index 71a01830..f64a3501 100644 --- a/impls/fsharp/core.fs +++ b/impls/fsharp/core.fs @@ -81,6 +81,12 @@ module Core |> List.rev |> Node.makeList + let vec = function + | [Vector(_, _) as v] -> v + | [List(_, xs)] -> Node.ofArray <| Array.ofSeq xs + | [_] -> raise <| Error.argMismatch () + | _ -> raise <| Error.wrongArity () + let nth = function | [List(_, lst); Number(n)] -> let rec nth_list n = function diff --git a/impls/fsharp/env.fs b/impls/fsharp/env.fs index e82ad924..07535dd4 100644 --- a/impls/fsharp/env.fs +++ b/impls/fsharp/env.fs @@ -65,6 +65,7 @@ module Env wrap "slurp" Core.slurp wrap "cons" Core.cons wrap "concat" Core.concat + wrap "vec" Core.vec wrap "nth" Core.nth wrap "first" Core.first wrap "rest" Core.rest diff --git a/impls/fsharp/step7_quote.fs b/impls/fsharp/step7_quote.fs index df0d09e2..83fe274b 100644 --- a/impls/fsharp/step7_quote.fs +++ b/impls/fsharp/step7_quote.fs @@ -10,19 +10,22 @@ module REPL | Empty -> () | _ -> raise <| Error.errExpectedX "list or vector" - let quasiquoteForm nodes = - let transformNode f = function - | Elements 1 [|a|] -> f a - | _ -> raise <| Error.wrongArity () - let singleNode = transformNode (fun n -> n) - let rec quasiquote node = - match node with - | Cons(Symbol("unquote"), rest) -> rest |> singleNode - | Cons(Cons(Symbol("splice-unquote"), spliceRest), rest) -> - makeList [Symbol("concat"); singleNode spliceRest; quasiquote rest] - | Cons(h, t) -> makeList [Symbol("cons"); quasiquote h; quasiquote t] - | n -> makeList [Symbol("quote"); n] - makeList nodes |> transformNode quasiquote + let rec qqLoop elt acc = + match elt with + | List(_, [Symbol("splice-unquote");list]) -> makeList [Symbol "concat"; list; acc] + | List(_, Symbol("splice-unquote")::_) -> raise <| Error.wrongArity () + | _ -> makeList [Symbol "cons"; quasiquote elt; acc] + and quasiquote = function + | List(_, [Symbol("unquote");form]) -> form + | List(_, Symbol("unquote")::_) -> raise <| Error.wrongArity () + | List (_, list) -> List.foldBack qqLoop list Node.EmptyLIST + | Vector(_, segment) -> + let array = Array.sub segment.Array segment.Offset segment.Count + let folded = Array.foldBack qqLoop array Node.EmptyLIST + makeList [Symbol "vec"; folded] + | Map(_) as ast -> makeList [Symbol "quote"; ast] + | Symbol(_) as ast -> makeList [Symbol "quote"; ast] + | ast -> ast let quoteForm = function | [node] -> node @@ -102,7 +105,10 @@ module REPL | List(_, Symbol("do")::rest) -> doForm env rest |> eval env | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | List(_, Symbol("quote")::rest) -> quoteForm rest - | List(_, Symbol("quasiquote")::rest) -> quasiquoteForm rest |> eval env + | List(_, [Symbol("quasiquoteexpand");form]) -> quasiquote form + | List(_, Symbol("quasiquoteexpand")::_) -> raise <| Error.wrongArity () + | List(_, [Symbol("quasiquote");form]) -> eval env <| quasiquote form + | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () | List(_, _) as node -> let resolved = node |> eval_ast env match resolved with diff --git a/impls/fsharp/step8_macros.fs b/impls/fsharp/step8_macros.fs index 95dbf311..95d27680 100644 --- a/impls/fsharp/step8_macros.fs +++ b/impls/fsharp/step8_macros.fs @@ -10,19 +10,22 @@ module REPL | Empty -> () | _ -> raise <| Error.errExpectedX "list or vector" - let quasiquoteForm nodes = - let transformNode f = function - | Elements 1 [|a|] -> f a - | _ -> raise <| Error.wrongArity () - let singleNode = transformNode (fun n -> n) - let rec quasiquote node = - match node with - | Cons(Symbol("unquote"), rest) -> rest |> singleNode - | Cons(Cons(Symbol("splice-unquote"), spliceRest), rest) -> - makeList [Symbol("concat"); singleNode spliceRest; quasiquote rest] - | Cons(h, t) -> makeList [Symbol("cons"); quasiquote h; quasiquote t] - | n -> makeList [Symbol("quote"); n] - makeList nodes |> transformNode quasiquote + let rec qqLoop elt acc = + match elt with + | List(_, [Symbol("splice-unquote");list]) -> makeList [Symbol "concat"; list; acc] + | List(_, Symbol("splice-unquote")::_) -> raise <| Error.wrongArity () + | _ -> makeList [Symbol "cons"; quasiquote elt; acc] + and quasiquote = function + | List(_, [Symbol("unquote");form]) -> form + | List(_, Symbol("unquote")::_) -> raise <| Error.wrongArity () + | List (_, list) -> List.foldBack qqLoop list Node.EmptyLIST + | Vector(_, segment) -> + let array = Array.sub segment.Array segment.Offset segment.Count + let folded = Array.foldBack qqLoop array Node.EmptyLIST + makeList [Symbol "vec"; folded] + | Map(_) as ast -> makeList [Symbol "quote"; ast] + | Symbol(_) as ast -> makeList [Symbol "quote"; ast] + | ast -> ast let quoteForm = function | [node] -> node @@ -129,7 +132,10 @@ module REPL | List(_, Symbol("do")::rest) -> doForm env rest |> eval env | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | List(_, Symbol("quote")::rest) -> quoteForm rest - | List(_, Symbol("quasiquote")::rest) -> quasiquoteForm rest |> eval env + | List(_, [Symbol("quasiquoteexpand");form]) -> quasiquote form + | List(_, Symbol("quasiquoteexpand")::_) -> raise <| Error.wrongArity () + | List(_, [Symbol("quasiquote");form]) -> eval env <| quasiquote form + | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () | List(_, _) as node -> let resolved = node |> eval_ast env match resolved with diff --git a/impls/fsharp/step9_try.fs b/impls/fsharp/step9_try.fs index a9883f7e..68e71588 100644 --- a/impls/fsharp/step9_try.fs +++ b/impls/fsharp/step9_try.fs @@ -10,19 +10,22 @@ module REPL | Empty -> () | _ -> raise <| Error.errExpectedX "list or vector" - let quasiquoteForm nodes = - let transformNode f = function - | Elements 1 [|a|] -> f a - | _ -> raise <| Error.wrongArity () - let singleNode = transformNode (fun n -> n) - let rec quasiquote node = - match node with - | Cons(Symbol("unquote"), rest) -> rest |> singleNode - | Cons(Cons(Symbol("splice-unquote"), spliceRest), rest) -> - makeList [Symbol("concat"); singleNode spliceRest; quasiquote rest] - | Cons(h, t) -> makeList [Symbol("cons"); quasiquote h; quasiquote t] - | n -> makeList [Symbol("quote"); n] - makeList nodes |> transformNode quasiquote + let rec qqLoop elt acc = + match elt with + | List(_, [Symbol("splice-unquote");list]) -> makeList [Symbol "concat"; list; acc] + | List(_, Symbol("splice-unquote")::_) -> raise <| Error.wrongArity () + | _ -> makeList [Symbol "cons"; quasiquote elt; acc] + and quasiquote = function + | List(_, [Symbol("unquote");form]) -> form + | List(_, Symbol("unquote")::_) -> raise <| Error.wrongArity () + | List (_, list) -> List.foldBack qqLoop list Node.EmptyLIST + | Vector(_, segment) -> + let array = Array.sub segment.Array segment.Offset segment.Count + let folded = Array.foldBack qqLoop array Node.EmptyLIST + makeList [Symbol "vec"; folded] + | Map(_) as ast -> makeList [Symbol "quote"; ast] + | Symbol(_) as ast -> makeList [Symbol "quote"; ast] + | ast -> ast let quoteForm = function | [node] -> node @@ -148,7 +151,10 @@ module REPL | List(_, Symbol("do")::rest) -> doForm env rest |> eval env | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | List(_, Symbol("quote")::rest) -> quoteForm rest - | List(_, Symbol("quasiquote")::rest) -> quasiquoteForm rest |> eval env + | List(_, [Symbol("quasiquoteexpand");form]) -> quasiquote form + | List(_, Symbol("quasiquoteexpand")::_) -> raise <| Error.wrongArity () + | List(_, [Symbol("quasiquote");form]) -> eval env <| quasiquote form + | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () | List(_, Symbol("try*")::rest) -> tryForm env rest | List(_, _) as node -> let resolved = node |> eval_ast env diff --git a/impls/fsharp/stepA_mal.fs b/impls/fsharp/stepA_mal.fs index 6960dae4..6417191b 100644 --- a/impls/fsharp/stepA_mal.fs +++ b/impls/fsharp/stepA_mal.fs @@ -10,19 +10,22 @@ module REPL | Empty -> () | _ -> raise <| Error.errExpectedX "list or vector" - let quasiquoteForm nodes = - let transformNode f = function - | Elements 1 [|a|] -> f a - | _ -> raise <| Error.wrongArity () - let singleNode = transformNode (fun n -> n) - let rec quasiquote node = - match node with - | Cons(Symbol("unquote"), rest) -> rest |> singleNode - | Cons(Cons(Symbol("splice-unquote"), spliceRest), rest) -> - makeList [Symbol("concat"); singleNode spliceRest; quasiquote rest] - | Cons(h, t) -> makeList [Symbol("cons"); quasiquote h; quasiquote t] - | n -> makeList [Symbol("quote"); n] - makeList nodes |> transformNode quasiquote + let rec qqLoop elt acc = + match elt with + | List(_, [Symbol("splice-unquote");list]) -> makeList [Symbol "concat"; list; acc] + | List(_, Symbol("splice-unquote")::_) -> raise <| Error.wrongArity () + | _ -> makeList [Symbol "cons"; quasiquote elt; acc] + and quasiquote = function + | List(_, [Symbol("unquote");form]) -> form + | List(_, Symbol("unquote")::_) -> raise <| Error.wrongArity () + | List (_, list) -> List.foldBack qqLoop list Node.EmptyLIST + | Vector(_, segment) -> + let array = Array.sub segment.Array segment.Offset segment.Count + let folded = Array.foldBack qqLoop array Node.EmptyLIST + makeList [Symbol "vec"; folded] + | Map(_) as ast -> makeList [Symbol "quote"; ast] + | Symbol(_) as ast -> makeList [Symbol "quote"; ast] + | ast -> ast let quoteForm = function | [node] -> node @@ -149,7 +152,10 @@ module REPL | List(_, Symbol("do")::rest) -> doForm env rest |> eval env | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | List(_, Symbol("quote")::rest) -> quoteForm rest - | List(_, Symbol("quasiquote")::rest) -> quasiquoteForm rest |> eval env + | List(_, [Symbol("quasiquoteexpand");form]) -> quasiquote form + | List(_, Symbol("quasiquoteexpand")::_) -> raise <| Error.wrongArity () + | List(_, [Symbol("quasiquote");form]) -> eval env <| quasiquote form + | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () | List(_, Symbol("try*")::rest) -> tryForm env rest | List(_, _) as node -> let resolved = node |> eval_ast env diff --git a/impls/gnu-smalltalk/core.st b/impls/gnu-smalltalk/core.st index bb85438c..4509facd 100644 --- a/impls/gnu-smalltalk/core.st +++ b/impls/gnu-smalltalk/core.st @@ -222,6 +222,8 @@ Core Ns at: #symbol put: (Fn new: [ :args | MALSymbol new: args first value asSymbol ]). Core Ns at: #keyword put: (Fn new: [ :args | MALKeyword new: args first value asSymbol ]). +Core Ns at: #'vec' put: + (Fn new: [ :args | MALVector new: args first value ]). Core Ns at: #vector put: (Fn new: [ :args | MALVector new: (OrderedCollection from: args) ]). Core Ns at: #'hash-map' put: diff --git a/impls/gnu-smalltalk/step7_quote.st b/impls/gnu-smalltalk/step7_quote.st index e779f684..b0e02de3 100644 --- a/impls/gnu-smalltalk/step7_quote.st +++ b/impls/gnu-smalltalk/step7_quote.st @@ -46,36 +46,44 @@ Object subclass: MAL [ ^aClass new: items ] + MAL class >> starts_with: ast sym: sym [ + | a a0 | + ast type = #list ifFalse: [ ^false. ]. + a := ast value. + a isEmpty ifTrue: [ ^false. ]. + a0 := a first. + ^a0 type = #symbol and: [ a0 value = sym ]. + ] + MAL class >> quasiquote: ast [ - | result a a0 a0_ a0_0 rest | - ast isPair ifFalse: [ + | result acc | + (ast type = #symbol or: [ ast type = #map ]) ifTrue: [ result := {MALSymbol new: #quote. ast}. ^MALList new: (OrderedCollection from: result) ]. - - a := ast value. - a0 := a first. - - (a0 type = #symbol and: [ a0 value = #unquote ]) ifTrue: [ ^a second ]. - - a0 isPair ifTrue: [ - a0_ := a0 value. - a0_0 := a0_ first. - - (a0_0 type = #symbol and: - [ a0_0 value = #'splice-unquote' ]) ifTrue: [ - rest := MALList new: a allButFirst. - result := {MALSymbol new: #concat. - a0_ second. - self quasiquote: rest}. - ^MALList new: (OrderedCollection from: result) - ] + (ast type = #list or: [ ast type = #vector ]) ifFalse: [ + ^ast ]. - rest := MALList new: a allButFirst. - result := {MALSymbol new: #cons. self quasiquote: a0. - self quasiquote: rest}. - ^MALList new: (OrderedCollection from: result) + (self starts_with: ast sym: #unquote) ifTrue: [ + ^ast value second + ]. + + result := {}. + acc := MALList new: (OrderedCollection from: result). + ast value reverseDo: [ : elt | + (self starts_with: elt sym: #'splice-unquote') ifTrue: [ + result := {MALSymbol new: #concat. elt value second. acc} + ] ifFalse: [ + result := {MALSymbol new: #cons. self quasiquote: elt. acc} + ]. + acc := MALList new: (OrderedCollection from: result) + ]. + ast type = #vector ifTrue: [ + result := {MALSymbol new: #vec. acc}. + acc := MALList new: (OrderedCollection from: result) + ]. + ^acc ] MAL class >> EVAL: aSexp env: anEnv [ @@ -157,6 +165,11 @@ Object subclass: MAL [ ^a1 ]. + a0_ = #quasiquoteexpand ifTrue: [ + a1 := ast second. + ^self quasiquote: a1. + ]. + a0_ = #quasiquote ifTrue: [ | result | a1 := ast second. diff --git a/impls/gnu-smalltalk/step8_macros.st b/impls/gnu-smalltalk/step8_macros.st index dcd06b93..94084320 100644 --- a/impls/gnu-smalltalk/step8_macros.st +++ b/impls/gnu-smalltalk/step8_macros.st @@ -46,36 +46,44 @@ Object subclass: MAL [ ^aClass new: items ] + MAL class >> starts_with: ast sym: sym [ + | a a0 | + ast type = #list ifFalse: [ ^false. ]. + a := ast value. + a isEmpty ifTrue: [ ^false. ]. + a0 := a first. + ^a0 type = #symbol and: [ a0 value = sym ]. + ] + MAL class >> quasiquote: ast [ - | result a a0 a0_ a0_0 rest | - ast isPair ifFalse: [ + | result acc | + (ast type = #symbol or: [ ast type = #map ]) ifTrue: [ result := {MALSymbol new: #quote. ast}. ^MALList new: (OrderedCollection from: result) ]. - - a := ast value. - a0 := a first. - - (a0 type = #symbol and: [ a0 value = #unquote ]) ifTrue: [ ^a second ]. - - a0 isPair ifTrue: [ - a0_ := a0 value. - a0_0 := a0_ first. - - (a0_0 type = #symbol and: - [ a0_0 value = #'splice-unquote' ]) ifTrue: [ - rest := MALList new: a allButFirst. - result := {MALSymbol new: #concat. - a0_ second. - self quasiquote: rest}. - ^MALList new: (OrderedCollection from: result) - ] + (ast type = #list or: [ ast type = #vector ]) ifFalse: [ + ^ast ]. - rest := MALList new: a allButFirst. - result := {MALSymbol new: #cons. self quasiquote: a0. - self quasiquote: rest}. - ^MALList new: (OrderedCollection from: result) + (self starts_with: ast sym: #unquote) ifTrue: [ + ^ast value second + ]. + + result := {}. + acc := MALList new: (OrderedCollection from: result). + ast value reverseDo: [ : elt | + (self starts_with: elt sym: #'splice-unquote') ifTrue: [ + result := {MALSymbol new: #concat. elt value second. acc} + ] ifFalse: [ + result := {MALSymbol new: #cons. self quasiquote: elt. acc} + ]. + acc := MALList new: (OrderedCollection from: result) + ]. + ast type = #vector ifTrue: [ + result := {MALSymbol new: #vec. acc}. + acc := MALList new: (OrderedCollection from: result) + ]. + ^acc ] MAL class >> isMacroCall: ast env: env [ @@ -210,6 +218,11 @@ Object subclass: MAL [ ^a1 ]. + a0_ = #quasiquoteexpand ifTrue: [ + a1 := ast second. + ^self quasiquote: a1. + ]. + a0_ = #quasiquote ifTrue: [ | result | a1 := ast second. diff --git a/impls/gnu-smalltalk/step9_try.st b/impls/gnu-smalltalk/step9_try.st index 05b3f773..47712132 100644 --- a/impls/gnu-smalltalk/step9_try.st +++ b/impls/gnu-smalltalk/step9_try.st @@ -46,36 +46,44 @@ Object subclass: MAL [ ^aClass new: items ] + MAL class >> starts_with: ast sym: sym [ + | a a0 | + ast type = #list ifFalse: [ ^false. ]. + a := ast value. + a isEmpty ifTrue: [ ^false. ]. + a0 := a first. + ^a0 type = #symbol and: [ a0 value = sym ]. + ] + MAL class >> quasiquote: ast [ - | result a a0 a0_ a0_0 rest | - ast isPair ifFalse: [ + | result acc | + (ast type = #symbol or: [ ast type = #map ]) ifTrue: [ result := {MALSymbol new: #quote. ast}. ^MALList new: (OrderedCollection from: result) ]. - - a := ast value. - a0 := a first. - - (a0 type = #symbol and: [ a0 value = #unquote ]) ifTrue: [ ^a second ]. - - a0 isPair ifTrue: [ - a0_ := a0 value. - a0_0 := a0_ first. - - (a0_0 type = #symbol and: - [ a0_0 value = #'splice-unquote' ]) ifTrue: [ - rest := MALList new: a allButFirst. - result := {MALSymbol new: #concat. - a0_ second. - self quasiquote: rest}. - ^MALList new: (OrderedCollection from: result) - ] + (ast type = #list or: [ ast type = #vector ]) ifFalse: [ + ^ast ]. - rest := MALList new: a allButFirst. - result := {MALSymbol new: #cons. self quasiquote: a0. - self quasiquote: rest}. - ^MALList new: (OrderedCollection from: result) + (self starts_with: ast sym: #unquote) ifTrue: [ + ^ast value second + ]. + + result := {}. + acc := MALList new: (OrderedCollection from: result). + ast value reverseDo: [ : elt | + (self starts_with: elt sym: #'splice-unquote') ifTrue: [ + result := {MALSymbol new: #concat. elt value second. acc} + ] ifFalse: [ + result := {MALSymbol new: #cons. self quasiquote: elt. acc} + ]. + acc := MALList new: (OrderedCollection from: result) + ]. + ast type = #vector ifTrue: [ + result := {MALSymbol new: #vec. acc}. + acc := MALList new: (OrderedCollection from: result) + ]. + ^acc ] MAL class >> isMacroCall: ast env: env [ @@ -210,6 +218,11 @@ Object subclass: MAL [ ^a1 ]. + a0_ = #quasiquoteexpand ifTrue: [ + a1 := ast second. + ^self quasiquote: a1. + ]. + a0_ = #quasiquote ifTrue: [ | result | a1 := ast second. diff --git a/impls/gnu-smalltalk/stepA_mal.st b/impls/gnu-smalltalk/stepA_mal.st index 6461c422..4394d527 100644 --- a/impls/gnu-smalltalk/stepA_mal.st +++ b/impls/gnu-smalltalk/stepA_mal.st @@ -46,36 +46,44 @@ Object subclass: MAL [ ^aClass new: items ] + MAL class >> starts_with: ast sym: sym [ + | a a0 | + ast type = #list ifFalse: [ ^false. ]. + a := ast value. + a isEmpty ifTrue: [ ^false. ]. + a0 := a first. + ^a0 type = #symbol and: [ a0 value = sym ]. + ] + MAL class >> quasiquote: ast [ - | result a a0 a0_ a0_0 rest | - ast isPair ifFalse: [ + | result acc | + (ast type = #symbol or: [ ast type = #map ]) ifTrue: [ result := {MALSymbol new: #quote. ast}. ^MALList new: (OrderedCollection from: result) ]. - - a := ast value. - a0 := a first. - - (a0 type = #symbol and: [ a0 value = #unquote ]) ifTrue: [ ^a second ]. - - a0 isPair ifTrue: [ - a0_ := a0 value. - a0_0 := a0_ first. - - (a0_0 type = #symbol and: - [ a0_0 value = #'splice-unquote' ]) ifTrue: [ - rest := MALList new: a allButFirst. - result := {MALSymbol new: #concat. - a0_ second. - self quasiquote: rest}. - ^MALList new: (OrderedCollection from: result) - ] + (ast type = #list or: [ ast type = #vector ]) ifFalse: [ + ^ast ]. - rest := MALList new: a allButFirst. - result := {MALSymbol new: #cons. self quasiquote: a0. - self quasiquote: rest}. - ^MALList new: (OrderedCollection from: result) + (self starts_with: ast sym: #unquote) ifTrue: [ + ^ast value second + ]. + + result := {}. + acc := MALList new: (OrderedCollection from: result). + ast value reverseDo: [ : elt | + (self starts_with: elt sym: #'splice-unquote') ifTrue: [ + result := {MALSymbol new: #concat. elt value second. acc} + ] ifFalse: [ + result := {MALSymbol new: #cons. self quasiquote: elt. acc} + ]. + acc := MALList new: (OrderedCollection from: result) + ]. + ast type = #vector ifTrue: [ + result := {MALSymbol new: #vec. acc}. + acc := MALList new: (OrderedCollection from: result) + ]. + ^acc ] MAL class >> isMacroCall: ast env: env [ @@ -210,6 +218,11 @@ Object subclass: MAL [ ^a1 ]. + a0_ = #quasiquoteexpand ifTrue: [ + a1 := ast second. + ^self quasiquote: a1. + ]. + a0_ = #quasiquote ifTrue: [ | result | a1 := ast second. diff --git a/impls/gnu-smalltalk/types.st b/impls/gnu-smalltalk/types.st index 6e9a1991..86c0da47 100644 --- a/impls/gnu-smalltalk/types.st +++ b/impls/gnu-smalltalk/types.st @@ -33,11 +33,6 @@ Object subclass: MALObject [ ^object ] - isPair [ - ^(self type = #list or: [ self type = #vector ]) and: - [ self value notEmpty ] - ] - printOn: stream [ stream nextPutAll: '<'; nextPutAll: self class printString; diff --git a/impls/go/src/core/core.go b/impls/go/src/core/core.go index 975f0447..2f980fd7 100644 --- a/impls/go/src/core/core.go +++ b/impls/go/src/core/core.go @@ -192,6 +192,17 @@ func concat(a []MalType) (MalType, error) { return List{slc1, nil}, nil } +func vec(a []MalType) (MalType, error) { + switch obj := a[0].(type) { + case Vector: + return obj, nil + case List: + return Vector{obj.Val, nil}, nil + default: + return nil, errors.New("vec: expects a sequence") + } +} + func nth(a []MalType) (MalType, error) { slc, e := GetSlice(a[0]) if e != nil { @@ -483,6 +494,7 @@ var NS = map[string]MalType{ "sequential?": call1b(Sequential_Q), "cons": call2e(cons), "concat": callNe(concat), + "vec": call1e(vec), "nth": call2e(nth), "first": call1e(first), "rest": call1e(rest), diff --git a/impls/go/src/step7_quote/step7_quote.go b/impls/go/src/step7_quote/step7_quote.go index a7502814..cef768a3 100644 --- a/impls/go/src/step7_quote/step7_quote.go +++ b/impls/go/src/step7_quote/step7_quote.go @@ -22,34 +22,48 @@ func READ(str string) (MalType, error) { } // eval -func is_pair(x MalType) bool { - slc, e := GetSlice(x) - if e != nil { - return false +func starts_with(xs []MalType, sym string) bool { + if 0 < len(xs) { + switch s := xs[0].(type) { + case Symbol: + return s.Val == sym + default: + } } - return len(slc) > 0 + return false +} + +func qq_loop(xs []MalType) MalType { + acc := NewList() + for i := len(xs) - 1; 0<=i; i -= 1 { + elt := xs[i] + switch e := elt.(type) { + case List: + if starts_with(e.Val, "splice-unquote") { + acc = NewList(Symbol{"concat"}, e.Val[1], acc) + continue + } + default: + } + acc = NewList(Symbol{"cons"}, quasiquote(elt), acc) + } + return acc } func quasiquote(ast MalType) MalType { - if !is_pair(ast) { - return List{[]MalType{Symbol{"quote"}, ast}, nil} - } else { - slc, _ := GetSlice(ast) - a0 := slc[0] - if Symbol_Q(a0) && (a0.(Symbol).Val == "unquote") { - return slc[1] - } else if is_pair(a0) { - slc0, _ := GetSlice(a0) - a00 := slc0[0] - if Symbol_Q(a00) && (a00.(Symbol).Val == "splice-unquote") { - return List{[]MalType{Symbol{"concat"}, - slc0[1], - quasiquote(List{slc[1:], nil})}, nil} - } + switch a := ast.(type) { + case Vector: + return NewList(Symbol{"vec"}, qq_loop(a.Val)) + case HashMap, Symbol: + return NewList(Symbol{"quote"}, ast) + case List: + if starts_with(a.Val,"unquote") { + return a.Val[1] + } else { + return qq_loop(a.Val) } - return List{[]MalType{Symbol{"cons"}, - quasiquote(a0), - quasiquote(List{slc[1:], nil})}, nil} + default: + return ast } } @@ -163,6 +177,8 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { env = let_env case "quote": return a1, nil + case "quasiquoteexpand": + return quasiquote(a1), nil case "quasiquote": ast = quasiquote(a1) case "do": diff --git a/impls/go/src/step8_macros/step8_macros.go b/impls/go/src/step8_macros/step8_macros.go index 902bf043..866a4cc3 100644 --- a/impls/go/src/step8_macros/step8_macros.go +++ b/impls/go/src/step8_macros/step8_macros.go @@ -22,34 +22,48 @@ func READ(str string) (MalType, error) { } // eval -func is_pair(x MalType) bool { - slc, e := GetSlice(x) - if e != nil { - return false +func starts_with(xs []MalType, sym string) bool { + if 0 < len(xs) { + switch s := xs[0].(type) { + case Symbol: + return s.Val == sym + default: + } } - return len(slc) > 0 + return false +} + +func qq_loop(xs []MalType) MalType { + acc := NewList() + for i := len(xs) - 1; 0<=i; i -= 1 { + elt := xs[i] + switch e := elt.(type) { + case List: + if starts_with(e.Val, "splice-unquote") { + acc = NewList(Symbol{"concat"}, e.Val[1], acc) + continue + } + default: + } + acc = NewList(Symbol{"cons"}, quasiquote(elt), acc) + } + return acc } func quasiquote(ast MalType) MalType { - if !is_pair(ast) { - return List{[]MalType{Symbol{"quote"}, ast}, nil} - } else { - slc, _ := GetSlice(ast) - a0 := slc[0] - if Symbol_Q(a0) && (a0.(Symbol).Val == "unquote") { - return slc[1] - } else if is_pair(a0) { - slc0, _ := GetSlice(a0) - a00 := slc0[0] - if Symbol_Q(a00) && (a00.(Symbol).Val == "splice-unquote") { - return List{[]MalType{Symbol{"concat"}, - slc0[1], - quasiquote(List{slc[1:], nil})}, nil} - } + switch a := ast.(type) { + case Vector: + return NewList(Symbol{"vec"}, qq_loop(a.Val)) + case HashMap, Symbol: + return NewList(Symbol{"quote"}, ast) + case List: + if starts_with(a.Val,"unquote") { + return a.Val[1] + } else { + return qq_loop(a.Val) } - return List{[]MalType{Symbol{"cons"}, - quasiquote(a0), - quasiquote(List{slc[1:], nil})}, nil} + default: + return ast } } @@ -210,6 +224,8 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { env = let_env case "quote": return a1, nil + case "quasiquoteexpand": + return quasiquote(a1), nil case "quasiquote": ast = quasiquote(a1) case "defmacro!": diff --git a/impls/go/src/step9_try/step9_try.go b/impls/go/src/step9_try/step9_try.go index 0e3a9e43..7044d008 100644 --- a/impls/go/src/step9_try/step9_try.go +++ b/impls/go/src/step9_try/step9_try.go @@ -22,34 +22,48 @@ func READ(str string) (MalType, error) { } // eval -func is_pair(x MalType) bool { - slc, e := GetSlice(x) - if e != nil { - return false +func starts_with(xs []MalType, sym string) bool { + if 0 < len(xs) { + switch s := xs[0].(type) { + case Symbol: + return s.Val == sym + default: + } } - return len(slc) > 0 + return false +} + +func qq_loop(xs []MalType) MalType { + acc := NewList() + for i := len(xs) - 1; 0<=i; i -= 1 { + elt := xs[i] + switch e := elt.(type) { + case List: + if starts_with(e.Val, "splice-unquote") { + acc = NewList(Symbol{"concat"}, e.Val[1], acc) + continue + } + default: + } + acc = NewList(Symbol{"cons"}, quasiquote(elt), acc) + } + return acc } func quasiquote(ast MalType) MalType { - if !is_pair(ast) { - return List{[]MalType{Symbol{"quote"}, ast}, nil} - } else { - slc, _ := GetSlice(ast) - a0 := slc[0] - if Symbol_Q(a0) && (a0.(Symbol).Val == "unquote") { - return slc[1] - } else if is_pair(a0) { - slc0, _ := GetSlice(a0) - a00 := slc0[0] - if Symbol_Q(a00) && (a00.(Symbol).Val == "splice-unquote") { - return List{[]MalType{Symbol{"concat"}, - slc0[1], - quasiquote(List{slc[1:], nil})}, nil} - } + switch a := ast.(type) { + case Vector: + return NewList(Symbol{"vec"}, qq_loop(a.Val)) + case HashMap, Symbol: + return NewList(Symbol{"quote"}, ast) + case List: + if starts_with(a.Val,"unquote") { + return a.Val[1] + } else { + return qq_loop(a.Val) } - return List{[]MalType{Symbol{"cons"}, - quasiquote(a0), - quasiquote(List{slc[1:], nil})}, nil} + default: + return ast } } @@ -210,6 +224,8 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { env = let_env case "quote": return a1, nil + case "quasiquoteexpand": + return quasiquote(a1), nil case "quasiquote": ast = quasiquote(a1) case "defmacro!": diff --git a/impls/go/src/stepA_mal/stepA_mal.go b/impls/go/src/stepA_mal/stepA_mal.go index 3b723d9c..b8e803e6 100644 --- a/impls/go/src/stepA_mal/stepA_mal.go +++ b/impls/go/src/stepA_mal/stepA_mal.go @@ -22,34 +22,48 @@ func READ(str string) (MalType, error) { } // eval -func is_pair(x MalType) bool { - slc, e := GetSlice(x) - if e != nil { - return false +func starts_with(xs []MalType, sym string) bool { + if 0 < len(xs) { + switch s := xs[0].(type) { + case Symbol: + return s.Val == sym + default: + } } - return len(slc) > 0 + return false +} + +func qq_loop(xs []MalType) MalType { + acc := NewList() + for i := len(xs) - 1; 0<=i; i -= 1 { + elt := xs[i] + switch e := elt.(type) { + case List: + if starts_with(e.Val, "splice-unquote") { + acc = NewList(Symbol{"concat"}, e.Val[1], acc) + continue + } + default: + } + acc = NewList(Symbol{"cons"}, quasiquote(elt), acc) + } + return acc } func quasiquote(ast MalType) MalType { - if !is_pair(ast) { - return List{[]MalType{Symbol{"quote"}, ast}, nil} - } else { - slc, _ := GetSlice(ast) - a0 := slc[0] - if Symbol_Q(a0) && (a0.(Symbol).Val == "unquote") { - return slc[1] - } else if is_pair(a0) { - slc0, _ := GetSlice(a0) - a00 := slc0[0] - if Symbol_Q(a00) && (a00.(Symbol).Val == "splice-unquote") { - return List{[]MalType{Symbol{"concat"}, - slc0[1], - quasiquote(List{slc[1:], nil})}, nil} - } + switch a := ast.(type) { + case Vector: + return NewList(Symbol{"vec"}, qq_loop(a.Val)) + case HashMap, Symbol: + return NewList(Symbol{"quote"}, ast) + case List: + if starts_with(a.Val,"unquote") { + return a.Val[1] + } else { + return qq_loop(a.Val) } - return List{[]MalType{Symbol{"cons"}, - quasiquote(a0), - quasiquote(List{slc[1:], nil})}, nil} + default: + return ast } } @@ -210,6 +224,8 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { env = let_env case "quote": return a1, nil + case "quasiquoteexpand": + return quasiquote(a1), nil case "quasiquote": ast = quasiquote(a1) case "defmacro!": diff --git a/impls/groovy/core.groovy b/impls/groovy/core.groovy index 7291de8e..aaf05d4a 100644 --- a/impls/groovy/core.groovy +++ b/impls/groovy/core.groovy @@ -112,6 +112,7 @@ class core { "sequential?": { a -> types.&sequential_Q(a[0]) }, "cons": { a -> [a[0]] + (a[1] as List) }, "concat": core.&do_concat, + "vec": { a -> types.vector_Q(a[0]) ? a[0] : types.vector(a[0]) }, "nth": core.&do_nth, "first": { a -> a[0] == null || a[0].size() == 0 ? null : a[0][0] }, "rest": { a -> a[0] == null ? [] as List : a[0].drop(1) }, diff --git a/impls/groovy/step7_quote.groovy b/impls/groovy/step7_quote.groovy index d0f3c1c7..829538e9 100644 --- a/impls/groovy/step7_quote.groovy +++ b/impls/groovy/step7_quote.groovy @@ -13,19 +13,36 @@ READ = { str -> } // EVAL -pair_Q = { ast -> types.sequential_Q(ast) && ast.size() > 0} -quasiquote = { ast -> - if (! pair_Q(ast)) { - [new MalSymbol("quote"), ast] - } else if (ast[0] != null && - ast[0].class == MalSymbol && - ast[0].value == "unquote") { - ast[1] - } else if (pair_Q(ast[0]) && ast[0][0].class == MalSymbol && - ast[0][0].value == "splice-unquote") { - [new MalSymbol("concat"), ast[0][1], quasiquote(ast.drop(1))] +starts_with = { lst, sym -> + lst.size() == 2 && lst[0].class == MalSymbol && lst[0].value == sym +} +qq_loop = { elt, acc -> + if (types.list_Q(elt) && starts_with(elt, "splice-unquote")) { + return [new MalSymbol("concat"), elt[1], acc] } else { - [new MalSymbol("cons"), quasiquote(ast[0]), quasiquote(ast.drop(1))] + return [new MalSymbol("cons"), quasiquote(elt), acc] + } +} +qq_foldr = { xs -> + def acc = [] + for (int i=xs.size()-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc +} +quasiquote = { ast -> + switch (ast) { + case List: + if (types.vector_Q(ast)) { + return [new MalSymbol("vec"), qq_foldr(ast)] + } else if (starts_with(ast, "unquote")) { + return ast[1] + } else { + return qq_foldr(ast) + } + case MalSymbol: return [new MalSymbol("quote"), ast] + case Map: return [new MalSymbol("quote"), ast] + default: return ast } } @@ -63,6 +80,8 @@ EVAL = { ast, env -> break // TCO case { it instanceof MalSymbol && it.value == "quote" }: return ast[1] + case { it instanceof MalSymbol && it.value == "quasiquoteexpand" }: + return quasiquote(ast[1]) case { it instanceof MalSymbol && it.value == "quasiquote" }: ast = quasiquote(ast[1]) break // TCO diff --git a/impls/groovy/step8_macros.groovy b/impls/groovy/step8_macros.groovy index 24da57fe..4622e22f 100644 --- a/impls/groovy/step8_macros.groovy +++ b/impls/groovy/step8_macros.groovy @@ -33,19 +33,36 @@ macroexpand = { ast, env -> return ast } -pair_Q = { ast -> types.sequential_Q(ast) && ast.size() > 0} -quasiquote = { ast -> - if (! pair_Q(ast)) { - [new MalSymbol("quote"), ast] - } else if (ast[0] != null && - ast[0].class == MalSymbol && - ast[0].value == "unquote") { - ast[1] - } else if (pair_Q(ast[0]) && ast[0][0].class == MalSymbol && - ast[0][0].value == "splice-unquote") { - [new MalSymbol("concat"), ast[0][1], quasiquote(ast.drop(1))] +starts_with = { lst, sym -> + lst.size() == 2 && lst[0].class == MalSymbol && lst[0].value == sym +} +qq_loop = { elt, acc -> + if (types.list_Q(elt) && starts_with(elt, "splice-unquote")) { + return [new MalSymbol("concat"), elt[1], acc] } else { - [new MalSymbol("cons"), quasiquote(ast[0]), quasiquote(ast.drop(1))] + return [new MalSymbol("cons"), quasiquote(elt), acc] + } +} +qq_foldr = { xs -> + def acc = [] + for (int i=xs.size()-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc +} +quasiquote = { ast -> + switch (ast) { + case List: + if (types.vector_Q(ast)) { + return [new MalSymbol("vec"), qq_foldr(ast)] + } else if (starts_with(ast, "unquote")) { + return ast[1] + } else { + return qq_foldr(ast) + } + case MalSymbol: return [new MalSymbol("quote"), ast] + case Map: return [new MalSymbol("quote"), ast] + default: return ast } } @@ -86,6 +103,8 @@ EVAL = { ast, env -> break // TCO case { it instanceof MalSymbol && it.value == "quote" }: return ast[1] + case { it instanceof MalSymbol && it.value == "quasiquoteexpand" }: + return quasiquote(ast[1]) case { it instanceof MalSymbol && it.value == "quasiquote" }: ast = quasiquote(ast[1]) break // TCO diff --git a/impls/groovy/step9_try.groovy b/impls/groovy/step9_try.groovy index 2ee26264..98fb8bd7 100644 --- a/impls/groovy/step9_try.groovy +++ b/impls/groovy/step9_try.groovy @@ -33,19 +33,36 @@ macroexpand = { ast, env -> return ast } -pair_Q = { ast -> types.sequential_Q(ast) && ast.size() > 0} -quasiquote = { ast -> - if (! pair_Q(ast)) { - [new MalSymbol("quote"), ast] - } else if (ast[0] != null && - ast[0].class == MalSymbol && - ast[0].value == "unquote") { - ast[1] - } else if (pair_Q(ast[0]) && ast[0][0].class == MalSymbol && - ast[0][0].value == "splice-unquote") { - [new MalSymbol("concat"), ast[0][1], quasiquote(ast.drop(1))] +starts_with = { lst, sym -> + lst.size() == 2 && lst[0].class == MalSymbol && lst[0].value == sym +} +qq_loop = { elt, acc -> + if (types.list_Q(elt) && starts_with(elt, "splice-unquote")) { + return [new MalSymbol("concat"), elt[1], acc] } else { - [new MalSymbol("cons"), quasiquote(ast[0]), quasiquote(ast.drop(1))] + return [new MalSymbol("cons"), quasiquote(elt), acc] + } +} +qq_foldr = { xs -> + def acc = [] + for (int i=xs.size()-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc +} +quasiquote = { ast -> + switch (ast) { + case List: + if (types.vector_Q(ast)) { + return [new MalSymbol("vec"), qq_foldr(ast)] + } else if (starts_with(ast, "unquote")) { + return ast[1] + } else { + return qq_foldr(ast) + } + case MalSymbol: return [new MalSymbol("quote"), ast] + case Map: return [new MalSymbol("quote"), ast] + default: return ast } } @@ -86,6 +103,8 @@ EVAL = { ast, env -> break // TCO case { it instanceof MalSymbol && it.value == "quote" }: return ast[1] + case { it instanceof MalSymbol && it.value == "quasiquoteexpand" }: + return quasiquote(ast[1]) case { it instanceof MalSymbol && it.value == "quasiquote" }: ast = quasiquote(ast[1]) break // TCO diff --git a/impls/groovy/stepA_mal.groovy b/impls/groovy/stepA_mal.groovy index 2d137861..323976e5 100644 --- a/impls/groovy/stepA_mal.groovy +++ b/impls/groovy/stepA_mal.groovy @@ -33,19 +33,36 @@ macroexpand = { ast, env -> return ast } -pair_Q = { ast -> types.sequential_Q(ast) && ast.size() > 0} -quasiquote = { ast -> - if (! pair_Q(ast)) { - [new MalSymbol("quote"), ast] - } else if (ast[0] != null && - ast[0].class == MalSymbol && - ast[0].value == "unquote") { - ast[1] - } else if (pair_Q(ast[0]) && ast[0][0].class == MalSymbol && - ast[0][0].value == "splice-unquote") { - [new MalSymbol("concat"), ast[0][1], quasiquote(ast.drop(1))] +starts_with = { lst, sym -> + lst.size() == 2 && lst[0].class == MalSymbol && lst[0].value == sym +} +qq_loop = { elt, acc -> + if (types.list_Q(elt) && starts_with(elt, "splice-unquote")) { + return [new MalSymbol("concat"), elt[1], acc] } else { - [new MalSymbol("cons"), quasiquote(ast[0]), quasiquote(ast.drop(1))] + return [new MalSymbol("cons"), quasiquote(elt), acc] + } +} +qq_foldr = { xs -> + def acc = [] + for (int i=xs.size()-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc +} +quasiquote = { ast -> + switch (ast) { + case List: + if (types.vector_Q(ast)) { + return [new MalSymbol("vec"), qq_foldr(ast)] + } else if (starts_with(ast, "unquote")) { + return ast[1] + } else { + return qq_foldr(ast) + } + case MalSymbol: return [new MalSymbol("quote"), ast] + case Map: return [new MalSymbol("quote"), ast] + default: return ast } } @@ -86,6 +103,8 @@ EVAL = { ast, env -> break // TCO case { it instanceof MalSymbol && it.value == "quote" }: return ast[1] + case { it instanceof MalSymbol && it.value == "quasiquoteexpand" }: + return quasiquote(ast[1]) case { it instanceof MalSymbol && it.value == "quasiquote" }: ast = quasiquote(ast[1]) break // TCO diff --git a/impls/guile/core.scm b/impls/guile/core.scm index 5831bc7d..4d86cc6d 100644 --- a/impls/guile/core.scm +++ b/impls/guile/core.scm @@ -19,6 +19,8 @@ (define (->list o) ((if (vector? o) vector->list identity) o)) +(define (vec lst) (if (vector? lst) lst (list->vector lst))) + (define (_count obj) (cond ((_nil? obj) 0) @@ -224,6 +226,7 @@ (slurp ,slurp) (cons ,_cons) (concat ,concat) + (vec ,vec) (nth ,_nth) (first ,_first) (rest ,_rest) diff --git a/impls/guile/step7_quote.scm b/impls/guile/step7_quote.scm index f6bcad53..bc3ec9b9 100644 --- a/impls/guile/step7_quote.scm +++ b/impls/guile/step7_quote.scm @@ -44,6 +44,19 @@ (EVAL (car ast) env) (eval_seq (cdr ast) env)))) +(define (qqIter elt acc) + (match elt + (('splice-unquote x) (list 'concat x acc)) + (else (list 'cons (_quasiquote elt) acc)))) +(define (_quasiquote ast) + (match ast + (('unquote x) x) + ( (xs ...) (fold-right qqIter '() xs)) + (#(xs ...) (list 'vec (fold-right qqIter '() xs))) + ((? hash-table?) (list 'quote ast)) + ((? symbol?) (list 'quote ast)) + (else ast))) + (define (EVAL ast env) (define (%unzip2 kvs) (let lp((next kvs) (k '()) (v '())) @@ -53,26 +66,13 @@ ((null? (cdr next)) (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs))) (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) - (define (_quasiquote obj) - (match obj - ((('unquote unq) rest ...) `(cons ,unq ,(_quasiquote rest))) - (('unquote unq) unq) - ((('splice-unquote unqsp) rest ...) `(concat ,unqsp ,(_quasiquote rest))) - ((head rest ...) (list 'cons (_quasiquote head) (_quasiquote rest))) - (else `(quote ,obj)))) - ;; NOTE: I wish I can use (while #t ...) for that, but this is not Lispy, which means - ;; it'll bring some trouble in control flow. We have to use continuations to return - ;; and use non-standard `break' feature. In a word, not elegant at all. - ;; The named let loop is natural for Scheme, but it looks a bit cheating. But NO! - ;; Such kind of loop is actually `while loop' in Scheme, I don't take advantage of - ;; TCO in Scheme to implement TCO, but it's the same principle with normal loop. - ;; If you're Lispy enough, there's no recursive at all while you saw named let loop. (let tco-loop((ast ast) (env env)) (match ast ((? non-list?) (eval_ast ast env)) (() ast) (('quote obj) obj) - (('quasiquote obj) (EVAL (_quasiquote (->list obj)) env)) + (('quasiquoteexpand obj) (_quasiquote obj)) + (('quasiquote obj) (EVAL (_quasiquote obj) env)) (('def! k v) ((env 'set) k (EVAL v env))) (('let* kvs body) (let* ((new-env (make-Env #:outer env)) diff --git a/impls/guile/step8_macros.scm b/impls/guile/step8_macros.scm index 6797acff..987c996a 100644 --- a/impls/guile/step8_macros.scm +++ b/impls/guile/step8_macros.scm @@ -44,6 +44,19 @@ (EVAL (car ast) env) (eval_seq (cdr ast) env)))) +(define (qqIter elt acc) + (match elt + (('splice-unquote x) (list 'concat x acc)) + (else (list 'cons (_quasiquote elt) acc)))) +(define (_quasiquote ast) + (match ast + (('unquote x) x) + ( (xs ...) (fold-right qqIter '() xs)) + (#(xs ...) (list 'vec (fold-right qqIter '() xs))) + ((? hash-table?) (list 'quote ast)) + ((? symbol?) (list 'quote ast)) + (else ast))) + (define (is_macro_call ast env) (and (list? ast) (> (length ast) 0) @@ -67,20 +80,6 @@ ((null? (cdr next)) (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs))) (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) - (define (_quasiquote obj) - (match obj - ((('unquote unq) rest ...) `(cons ,unq ,(_quasiquote rest))) - (('unquote unq) unq) - ((('splice-unquote unqsp) rest ...) `(concat ,unqsp ,(_quasiquote rest))) - ((head rest ...) (list 'cons (_quasiquote head) (_quasiquote rest))) - (else `(quote ,obj)))) - ;; NOTE: I wish I can use (while #t ...) for that, but this is not Lispy, which means - ;; it'll bring some trouble in control flow. We have to use continuations to return - ;; and use non-standard `break' feature. In a word, not elegant at all. - ;; The named let loop is natural for Scheme, but it looks a bit cheating. But NO! - ;; Such kind of loop is actually `while loop' in Scheme, I don't take advantage of - ;; TCO in Scheme to implement TCO, but it's the same principle with normal loop. - ;; If you're Lispy enough, there's no recursive at all while you saw named let loop. (let tco-loop((ast ast) (env env)) ; expand as possible (let ((ast (_macroexpand ast env))) (match ast @@ -92,7 +91,8 @@ ((env 'set) k c))) (('macroexpand obj) (_macroexpand obj env)) (('quote obj) obj) - (('quasiquote obj) (EVAL (_quasiquote (->list obj)) env)) + (('quasiquoteexpand obj) (_quasiquote obj)) + (('quasiquote obj) (EVAL (_quasiquote obj) env)) (('def! k v) ((env 'set) k (EVAL v env))) (('let* kvs body) (let* ((new-env (make-Env #:outer env)) diff --git a/impls/guile/step9_try.scm b/impls/guile/step9_try.scm index af4701aa..6964a0a1 100644 --- a/impls/guile/step9_try.scm +++ b/impls/guile/step9_try.scm @@ -54,6 +54,19 @@ (EVAL (car ast) env) (eval_seq (cdr ast) env)))) +(define (qqIter elt acc) + (match elt + (('splice-unquote x) (list 'concat x acc)) + (else (list 'cons (_quasiquote elt) acc)))) +(define (_quasiquote ast) + (match ast + (('unquote x) x) + ( (xs ...) (fold-right qqIter '() xs)) + (#(xs ...) (list 'vec (fold-right qqIter '() xs))) + ((? hash-table?) (list 'quote ast)) + ((? symbol?) (list 'quote ast)) + (else ast))) + (define (is_macro_call ast env) (and (list? ast) (> (length ast) 0) @@ -79,20 +92,6 @@ ((null? (cdr next)) (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs))) (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) - (define (_quasiquote obj) - (match obj - ((('unquote unq) rest ...) `(cons ,unq ,(_quasiquote rest))) - (('unquote unq) unq) - ((('splice-unquote unqsp) rest ...) `(concat ,unqsp ,(_quasiquote rest))) - ((head rest ...) (list 'cons (_quasiquote head) (_quasiquote rest))) - (else `(quote ,obj)))) - ;; NOTE: I wish I can use (while #t ...) for that, but this is not Lispy, which means - ;; it'll bring some trouble in control flow. We have to use continuations to return - ;; and use non-standard `break' feature. In a word, not elegant at all. - ;; The named let loop is natural for Scheme, but it looks a bit cheating. But NO! - ;; Such kind of loop is actually `while loop' in Scheme, I don't take advantage of - ;; TCO in Scheme to implement TCO, but it's the same principle with normal loop. - ;; If you're Lispy enough, there's no recursive at all while you saw named let loop. (let tco-loop((ast ast) (env env)) ; expand as possible ;;(format #t "CCC: ~a === ~a~%" ast (_macroexpand ast env)) (let ((ast (_macroexpand ast env))) @@ -105,7 +104,8 @@ ((env 'set) k c))) (('macroexpand obj) (_macroexpand obj env)) (('quote obj) obj) - (('quasiquote obj) (EVAL (_quasiquote (->list obj)) env)) + (('quasiquoteexpand obj) (_quasiquote obj)) + (('quasiquote obj) (EVAL (_quasiquote obj) env)) (('def! k v) ((env 'set) k (EVAL v env))) (('let* kvs body) (let* ((new-env (make-Env #:outer env)) diff --git a/impls/guile/stepA_mal.scm b/impls/guile/stepA_mal.scm index 7131147e..7885078b 100644 --- a/impls/guile/stepA_mal.scm +++ b/impls/guile/stepA_mal.scm @@ -54,6 +54,19 @@ (EVAL (car ast) env) (eval_seq (cdr ast) env)))) +(define (qqIter elt acc) + (match elt + (('splice-unquote x) (list 'concat x acc)) + (else (list 'cons (_quasiquote elt) acc)))) +(define (_quasiquote ast) + (match ast + (('unquote x) x) + ( (xs ...) (fold-right qqIter '() xs)) + (#(xs ...) (list 'vec (fold-right qqIter '() xs))) + ((? hash-table?) (list 'quote ast)) + ((? symbol?) (list 'quote ast)) + (else ast))) + (define (is_macro_call ast env) (and (list? ast) (> (length ast) 0) @@ -77,20 +90,6 @@ ((null? (cdr next)) (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs))) (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) - (define (_quasiquote obj) - (match obj - ((('unquote unq) rest ...) `(cons ,unq ,(_quasiquote rest))) - (('unquote unq) unq) - ((('splice-unquote unqsp) rest ...) `(concat ,unqsp ,(_quasiquote rest))) - ((head rest ...) (list 'cons (_quasiquote head) (_quasiquote rest))) - (else `(quote ,obj)))) - ;; NOTE: I wish I can use (while #t ...) for that, but this is not Lispy, which means - ;; it'll bring some trouble in control flow. We have to use continuations to return - ;; and use non-standard `break' feature. In a word, not elegant at all. - ;; The named let loop is natural for Scheme, but it looks a bit cheating. But NO! - ;; Such kind of loop is actually `while loop' in Scheme, I don't take advantage of - ;; TCO in Scheme to implement TCO, but it's the same principle with normal loop. - ;; If you're Lispy enough, there's no recursive at all while you saw named let loop. (let tco-loop((ast ast) (env env)) ; expand as possible (let ((ast (_macroexpand ast env))) (match ast @@ -102,7 +101,8 @@ ((env 'set) k c))) (('macroexpand obj) (_macroexpand obj env)) (('quote obj) obj) - (('quasiquote obj) (EVAL (_quasiquote (->list obj)) env)) + (('quasiquoteexpand obj) (_quasiquote obj)) + (('quasiquote obj) (EVAL (_quasiquote obj) env)) (('def! k v) ((env 'set) k (EVAL v env))) (('let* kvs body) (let* ((new-env (make-Env #:outer env)) diff --git a/impls/haskell/Core.hs b/impls/haskell/Core.hs index 456ff3f1..e07d7873 100644 --- a/impls/haskell/Core.hs +++ b/impls/haskell/Core.hs @@ -220,6 +220,11 @@ unwrapSeq _ = throwStr "invalid concat" do_concat :: Fn do_concat args = toList . concat <$> mapM unwrapSeq args +vec :: Fn +vec [MalSeq _ _ xs] = return $ MalSeq (MetaData Nil) (Vect True) xs +vec [_] = throwStr "vec: arg type" +vec _ = throwStr "vec: arg count" + nth :: Fn nth [MalSeq _ _ lst, MalNumber idx] = case drop idx lst of @@ -366,6 +371,7 @@ ns = [ ("sequential?", pred1 sequential_Q), ("cons", cons), ("concat", do_concat), + ("vec", vec), ("nth", nth), ("first", first), ("rest", rest), diff --git a/impls/haskell/step7_quote.hs b/impls/haskell/step7_quote.hs index 6a2ce900..30806880 100644 --- a/impls/haskell/step7_quote.hs +++ b/impls/haskell/step7_quote.hs @@ -21,22 +21,23 @@ mal_read = read_str -- starts-with is replaced with pattern matching. -qqIter :: Env -> MalVal -> [MalVal] -> IOThrows [MalVal] -qqIter env (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = do - evaluated <- eval env x - case evaluated of - MalSeq _ (Vect False) xs -> return $ xs ++ acc - _ -> throwStr "invalid splice-unquote argument" -qqIter _ (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote" -qqIter env x acc = (: acc) <$> quasiquote x env +qqIter :: MalVal -> MalVal -> IOThrows MalVal +qqIter (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = return $ toList [MalSymbol "concat", x, acc] +qqIter (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote" +qqIter elt acc = do + qqted <- quasiquote elt + return $ toList [MalSymbol "cons", qqted, acc] -quasiquote :: MalVal -> Env -> IOThrows MalVal -quasiquote (MalSeq _ (Vect False) [MalSymbol "unquote", x]) env = eval env x --- FIXME This line -quasiquote (MalSeq m _ ys) env = MalSeq m (Vect False) <$> foldrM (qqIter env) [] ys --- is adapted to broken tests. It should be: --- quasiquote (MalSeq m v ys) env = MalSeq m v <$> foldrM (qqIter env) [] ys -quasiquote ast _ = return ast +quasiquote :: MalVal -> IOThrows MalVal +quasiquote (MalSeq _ (Vect False) [MalSymbol "unquote", x]) = return x +quasiquote (MalSeq _ (Vect False) (MalSymbol "unquote" : _)) = throwStr "invalid unquote" +quasiquote (MalSeq _ (Vect False) ys) = foldrM qqIter (toList []) ys +quasiquote (MalSeq _ (Vect True) ys) = do + lst <- foldrM qqIter (toList []) ys + return $ toList [MalSymbol "vec", lst] +quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast@(MalSymbol _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast = return ast -- eval_ast is replaced with pattern matching. @@ -79,7 +80,10 @@ apply_ast (MalSymbol "let*" : _) _ = throwStr "invalid let*" apply_ast [MalSymbol "quote", a1] _ = return a1 apply_ast (MalSymbol "quote" : _) _ = throwStr "invalid quote" -apply_ast [MalSymbol "quasiquote", a1] env = quasiquote a1 env +apply_ast [MalSymbol "quasiquoteexpand", a1] _ = quasiquote a1 +apply_ast (MalSymbol "quasiquoteexpand" : _) _ = throwStr "invalid quasiquote" + +apply_ast [MalSymbol "quasiquote", a1] env = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote" : _) _ = throwStr "invalid quasiquote" apply_ast (MalSymbol "do" : args) env = foldlM (const $ eval env) Nil args diff --git a/impls/haskell/step8_macros.hs b/impls/haskell/step8_macros.hs index b42e09a4..b3ad713d 100644 --- a/impls/haskell/step8_macros.hs +++ b/impls/haskell/step8_macros.hs @@ -21,22 +21,23 @@ mal_read = read_str -- starts-with is replaced with pattern matching. -qqIter :: Env -> MalVal -> [MalVal] -> IOThrows [MalVal] -qqIter env (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = do - evaluated <- eval env x - case evaluated of - MalSeq _ (Vect False) xs -> return $ xs ++ acc - _ -> throwStr "invalid splice-unquote argument" -qqIter _ (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote" -qqIter env x acc = (: acc) <$> quasiquote x env +qqIter :: MalVal -> MalVal -> IOThrows MalVal +qqIter (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = return $ toList [MalSymbol "concat", x, acc] +qqIter (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote" +qqIter elt acc = do + qqted <- quasiquote elt + return $ toList [MalSymbol "cons", qqted, acc] -quasiquote :: MalVal -> Env -> IOThrows MalVal -quasiquote (MalSeq _ (Vect False) [MalSymbol "unquote", x]) env = eval env x --- FIXME This line -quasiquote (MalSeq m _ ys) env = MalSeq m (Vect False) <$> foldrM (qqIter env) [] ys --- is adapted to broken tests. It should be: --- quasiquote (MalSeq m v ys) env = MalSeq m v <$> foldrM (qqIter env) [] ys -quasiquote ast _ = return ast +quasiquote :: MalVal -> IOThrows MalVal +quasiquote (MalSeq _ (Vect False) [MalSymbol "unquote", x]) = return x +quasiquote (MalSeq _ (Vect False) (MalSymbol "unquote" : _)) = throwStr "invalid unquote" +quasiquote (MalSeq _ (Vect False) ys) = foldrM qqIter (toList []) ys +quasiquote (MalSeq _ (Vect True) ys) = do + lst <- foldrM qqIter (toList []) ys + return $ toList [MalSymbol "vec", lst] +quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast@(MalSymbol _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast = return ast -- is-macro-call is replaced with pattern matching. @@ -89,7 +90,10 @@ apply_ast (MalSymbol "let*" : _) _ = throwStr "invalid let*" apply_ast [MalSymbol "quote", a1] _ = return a1 apply_ast (MalSymbol "quote" : _) _ = throwStr "invalid quote" -apply_ast [MalSymbol "quasiquote", a1] env = quasiquote a1 env +apply_ast [MalSymbol "quasiquoteexpand", a1] _ = quasiquote a1 +apply_ast (MalSymbol "quasiquoteexpand" : _) _ = throwStr "invalid quasiquote" + +apply_ast [MalSymbol "quasiquote", a1] env = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote" : _) _ = throwStr "invalid quasiquote" apply_ast [MalSymbol "defmacro!", MalSymbol a1, a2] env = do diff --git a/impls/haskell/step9_try.hs b/impls/haskell/step9_try.hs index c2651dd5..e4834e66 100644 --- a/impls/haskell/step9_try.hs +++ b/impls/haskell/step9_try.hs @@ -21,22 +21,23 @@ mal_read = read_str -- starts-with is replaced with pattern matching. -qqIter :: Env -> MalVal -> [MalVal] -> IOThrows [MalVal] -qqIter env (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = do - evaluated <- eval env x - case evaluated of - MalSeq _ (Vect False) xs -> return $ xs ++ acc - _ -> throwStr "invalid splice-unquote argument" -qqIter _ (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote" -qqIter env x acc = (: acc) <$> quasiquote x env +qqIter :: MalVal -> MalVal -> IOThrows MalVal +qqIter (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = return $ toList [MalSymbol "concat", x, acc] +qqIter (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote" +qqIter elt acc = do + qqted <- quasiquote elt + return $ toList [MalSymbol "cons", qqted, acc] -quasiquote :: MalVal -> Env -> IOThrows MalVal -quasiquote (MalSeq _ (Vect False) [MalSymbol "unquote", x]) env = eval env x --- FIXME This line -quasiquote (MalSeq m _ ys) env = MalSeq m (Vect False) <$> foldrM (qqIter env) [] ys --- is adapted to broken tests. It should be: --- quasiquote (MalSeq m v ys) env = MalSeq m v <$> foldrM (qqIter env) [] ys -quasiquote ast _ = return ast +quasiquote :: MalVal -> IOThrows MalVal +quasiquote (MalSeq _ (Vect False) [MalSymbol "unquote", x]) = return x +quasiquote (MalSeq _ (Vect False) (MalSymbol "unquote" : _)) = throwStr "invalid unquote" +quasiquote (MalSeq _ (Vect False) ys) = foldrM qqIter (toList []) ys +quasiquote (MalSeq _ (Vect True) ys) = do + lst <- foldrM qqIter (toList []) ys + return $ toList [MalSymbol "vec", lst] +quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast@(MalSymbol _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast = return ast -- is-macro-call is replaced with pattern matching. @@ -89,7 +90,10 @@ apply_ast (MalSymbol "let*" : _) _ = throwStr "invalid let*" apply_ast [MalSymbol "quote", a1] _ = return a1 apply_ast (MalSymbol "quote" : _) _ = throwStr "invalid quote" -apply_ast [MalSymbol "quasiquote", a1] env = quasiquote a1 env +apply_ast [MalSymbol "quasiquoteexpand", a1] _ = quasiquote a1 +apply_ast (MalSymbol "quasiquoteexpand" : _) _ = throwStr "invalid quasiquote" + +apply_ast [MalSymbol "quasiquote", a1] env = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote" : _) _ = throwStr "invalid quasiquote" apply_ast [MalSymbol "defmacro!", MalSymbol a1, a2] env = do diff --git a/impls/haskell/stepA_mal.hs b/impls/haskell/stepA_mal.hs index 4b6ed5d5..a392be67 100644 --- a/impls/haskell/stepA_mal.hs +++ b/impls/haskell/stepA_mal.hs @@ -21,22 +21,23 @@ mal_read = read_str -- starts-with is replaced with pattern matching. -qqIter :: Env -> MalVal -> [MalVal] -> IOThrows [MalVal] -qqIter env (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = do - evaluated <- eval env x - case evaluated of - MalSeq _ (Vect False) xs -> return $ xs ++ acc - _ -> throwStr "invalid splice-unquote argument" -qqIter _ (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote" -qqIter env x acc = (: acc) <$> quasiquote x env +qqIter :: MalVal -> MalVal -> IOThrows MalVal +qqIter (MalSeq _ (Vect False) [MalSymbol "splice-unquote", x]) acc = return $ toList [MalSymbol "concat", x, acc] +qqIter (MalSeq _ (Vect False) (MalSymbol "splice-unquote" : _)) _ = throwStr "invalid splice-unquote" +qqIter elt acc = do + qqted <- quasiquote elt + return $ toList [MalSymbol "cons", qqted, acc] -quasiquote :: MalVal -> Env -> IOThrows MalVal -quasiquote (MalSeq _ (Vect False) [MalSymbol "unquote", x]) env = eval env x --- FIXME This line -quasiquote (MalSeq m _ ys) env = MalSeq m (Vect False) <$> foldrM (qqIter env) [] ys --- is adapted to broken tests. It should be: --- quasiquote (MalSeq m v ys) env = MalSeq m v <$> foldrM (qqIter env) [] ys -quasiquote ast _ = return ast +quasiquote :: MalVal -> IOThrows MalVal +quasiquote (MalSeq _ (Vect False) [MalSymbol "unquote", x]) = return x +quasiquote (MalSeq _ (Vect False) (MalSymbol "unquote" : _)) = throwStr "invalid unquote" +quasiquote (MalSeq _ (Vect False) ys) = foldrM qqIter (toList []) ys +quasiquote (MalSeq _ (Vect True) ys) = do + lst <- foldrM qqIter (toList []) ys + return $ toList [MalSymbol "vec", lst] +quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast@(MalSymbol _) = return $ toList [MalSymbol "quote", ast] +quasiquote ast = return ast -- is-macro-call is replaced with pattern matching. @@ -89,7 +90,10 @@ apply_ast (MalSymbol "let*" : _) _ = throwStr "invalid let*" apply_ast [MalSymbol "quote", a1] _ = return a1 apply_ast (MalSymbol "quote" : _) _ = throwStr "invalid quote" -apply_ast [MalSymbol "quasiquote", a1] env = quasiquote a1 env +apply_ast [MalSymbol "quasiquoteexpand", a1] _ = quasiquote a1 +apply_ast (MalSymbol "quasiquoteexpand" : _) _ = throwStr "invalid quasiquote" + +apply_ast [MalSymbol "quasiquote", a1] env = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote" : _) _ = throwStr "invalid quasiquote" apply_ast [MalSymbol "defmacro!", MalSymbol a1, a2] env = do diff --git a/impls/haxe/Step7_quote.hx b/impls/haxe/Step7_quote.hx index 548dc172..a42b36c4 100644 --- a/impls/haxe/Step7_quote.hx +++ b/impls/haxe/Step7_quote.hx @@ -14,31 +14,28 @@ class Step7_quote { } // EVAL - static function is_pair(ast:MalType) { - return switch (ast) { - case MalList(l) | MalVector(l): l.length > 0; - case _: false; + static function qq_loop(elt:MalType, acc:MalType) { + switch elt { + case MalList([MalSymbol("splice-unquote"), arg]): + return MalList([MalSymbol("concat"), arg, acc]); + case _: + return MalList([MalSymbol("cons"), quasiquote(elt), acc]); } } - + static function qq_foldr(xs:Array) { + var acc = MalList([]); + for (i in 1 ... xs.length+1) { + acc = qq_loop (xs[xs.length-i], acc); + } + return acc; + } static function quasiquote(ast:MalType) { - if (!is_pair(ast)) { - return MalList([MalSymbol("quote"), ast]); - } else { - var a0 = first(ast); - if (_equal_Q(a0, MalSymbol("unquote"))) { - return _nth(ast, 1); - } else if (is_pair(a0)) { - var a00 = first(a0); - if (_equal_Q(a00, MalSymbol("splice-unquote"))) { - return MalList([MalSymbol("concat"), - _nth(a0, 1), - quasiquote(rest(ast))]); - } - } - return MalList([MalSymbol("cons"), - quasiquote(a0), - quasiquote(rest(ast))]); + return switch(ast) { + case MalList([MalSymbol("unquote"), arg]): arg; + case MalList(l): qq_foldr(l); + case MalVector(l): MalList([MalSymbol("vec"), qq_foldr(l)]); + case MalSymbol(_) | MalHashMap(_): MalList([MalSymbol("quote"), ast]); + case _: ast; } } @@ -85,6 +82,8 @@ class Step7_quote { continue; // TCO case MalSymbol("quote"): return alst[1]; + case MalSymbol("quasiquoteexpand"): + return quasiquote(alst[1]); case MalSymbol("quasiquote"): ast = quasiquote(alst[1]); continue; // TCO diff --git a/impls/haxe/Step8_macros.hx b/impls/haxe/Step8_macros.hx index 3ff57433..d76a54c7 100644 --- a/impls/haxe/Step8_macros.hx +++ b/impls/haxe/Step8_macros.hx @@ -14,31 +14,28 @@ class Step8_macros { } // EVAL - static function is_pair(ast:MalType) { - return switch (ast) { - case MalList(l) | MalVector(l): l.length > 0; - case _: false; + static function qq_loop(elt:MalType, acc:MalType) { + switch elt { + case MalList([MalSymbol("splice-unquote"), arg]): + return MalList([MalSymbol("concat"), arg, acc]); + case _: + return MalList([MalSymbol("cons"), quasiquote(elt), acc]); } } - + static function qq_foldr(xs:Array) { + var acc = MalList([]); + for (i in 1 ... xs.length+1) { + acc = qq_loop (xs[xs.length-i], acc); + } + return acc; + } static function quasiquote(ast:MalType) { - if (!is_pair(ast)) { - return MalList([MalSymbol("quote"), ast]); - } else { - var a0 = first(ast); - if (_equal_Q(a0, MalSymbol("unquote"))) { - return _nth(ast, 1); - } else if (is_pair(a0)) { - var a00 = first(a0); - if (_equal_Q(a00, MalSymbol("splice-unquote"))) { - return MalList([MalSymbol("concat"), - _nth(a0, 1), - quasiquote(rest(ast))]); - } - } - return MalList([MalSymbol("cons"), - quasiquote(a0), - quasiquote(rest(ast))]); + return switch(ast) { + case MalList([MalSymbol("unquote"), arg]): arg; + case MalList(l): qq_foldr(l); + case MalVector(l): MalList([MalSymbol("vec"), qq_foldr(l)]); + case MalSymbol(_) | MalHashMap(_): MalList([MalSymbol("quote"), ast]); + case _: ast; } } @@ -111,6 +108,8 @@ class Step8_macros { continue; // TCO case MalSymbol("quote"): return alst[1]; + case MalSymbol("quasiquoteexpand"): + return quasiquote(alst[1]); case MalSymbol("quasiquote"): ast = quasiquote(alst[1]); continue; // TCO diff --git a/impls/haxe/Step9_try.hx b/impls/haxe/Step9_try.hx index ee7d7218..e2bfbeaf 100644 --- a/impls/haxe/Step9_try.hx +++ b/impls/haxe/Step9_try.hx @@ -15,31 +15,28 @@ class Step9_try { } // EVAL - static function is_pair(ast:MalType) { - return switch (ast) { - case MalList(l) | MalVector(l): l.length > 0; - case _: false; + static function qq_loop(elt:MalType, acc:MalType) { + switch elt { + case MalList([MalSymbol("splice-unquote"), arg]): + return MalList([MalSymbol("concat"), arg, acc]); + case _: + return MalList([MalSymbol("cons"), quasiquote(elt), acc]); } } - + static function qq_foldr(xs:Array) { + var acc = MalList([]); + for (i in 1 ... xs.length+1) { + acc = qq_loop (xs[xs.length-i], acc); + } + return acc; + } static function quasiquote(ast:MalType) { - if (!is_pair(ast)) { - return MalList([MalSymbol("quote"), ast]); - } else { - var a0 = first(ast); - if (_equal_Q(a0, MalSymbol("unquote"))) { - return _nth(ast, 1); - } else if (is_pair(a0)) { - var a00 = first(a0); - if (_equal_Q(a00, MalSymbol("splice-unquote"))) { - return MalList([MalSymbol("concat"), - _nth(a0, 1), - quasiquote(rest(ast))]); - } - } - return MalList([MalSymbol("cons"), - quasiquote(a0), - quasiquote(rest(ast))]); + return switch(ast) { + case MalList([MalSymbol("unquote"), arg]): arg; + case MalList(l): qq_foldr(l); + case MalVector(l): MalList([MalSymbol("vec"), qq_foldr(l)]); + case MalSymbol(_) | MalHashMap(_): MalList([MalSymbol("quote"), ast]); + case _: ast; } } @@ -112,6 +109,8 @@ class Step9_try { continue; // TCO case MalSymbol("quote"): return alst[1]; + case MalSymbol("quasiquoteexpand"): + return quasiquote(alst[1]); case MalSymbol("quasiquote"): ast = quasiquote(alst[1]); continue; // TCO diff --git a/impls/haxe/StepA_mal.hx b/impls/haxe/StepA_mal.hx index 6a07558f..7a89cda1 100644 --- a/impls/haxe/StepA_mal.hx +++ b/impls/haxe/StepA_mal.hx @@ -15,31 +15,28 @@ class StepA_mal { } // EVAL - static function is_pair(ast:MalType) { - return switch (ast) { - case MalList(l) | MalVector(l): l.length > 0; - case _: false; + static function qq_loop(elt:MalType, acc:MalType) { + switch elt { + case MalList([MalSymbol("splice-unquote"), arg]): + return MalList([MalSymbol("concat"), arg, acc]); + case _: + return MalList([MalSymbol("cons"), quasiquote(elt), acc]); } } - + static function qq_foldr(xs:Array) { + var acc = MalList([]); + for (i in 1 ... xs.length+1) { + acc = qq_loop (xs[xs.length-i], acc); + } + return acc; + } static function quasiquote(ast:MalType) { - if (!is_pair(ast)) { - return MalList([MalSymbol("quote"), ast]); - } else { - var a0 = first(ast); - if (_equal_Q(a0, MalSymbol("unquote"))) { - return _nth(ast, 1); - } else if (is_pair(a0)) { - var a00 = first(a0); - if (_equal_Q(a00, MalSymbol("splice-unquote"))) { - return MalList([MalSymbol("concat"), - _nth(a0, 1), - quasiquote(rest(ast))]); - } - } - return MalList([MalSymbol("cons"), - quasiquote(a0), - quasiquote(rest(ast))]); + return switch(ast) { + case MalList([MalSymbol("unquote"), arg]): arg; + case MalList(l): qq_foldr(l); + case MalVector(l): MalList([MalSymbol("vec"), qq_foldr(l)]); + case MalSymbol(_) | MalHashMap(_): MalList([MalSymbol("quote"), ast]); + case _: ast; } } @@ -112,6 +109,8 @@ class StepA_mal { continue; // TCO case MalSymbol("quote"): return alst[1]; + case MalSymbol("quasiquoteexpand"): + return quasiquote(alst[1]); case MalSymbol("quasiquote"): ast = quasiquote(alst[1]); continue; // TCO diff --git a/impls/haxe/core/Core.hx b/impls/haxe/core/Core.hx index d7b82d3b..99eae9b7 100644 --- a/impls/haxe/core/Core.hx +++ b/impls/haxe/core/Core.hx @@ -140,6 +140,17 @@ class Core { return MalList(res); } + static function do_vec(args:Array) { + switch (args[0]) { + case MalList(l): + return MalVector(l); + case MalVector(l): + return args[0]; + case _: + throw "vec called with non-sequence"; + } + } + static function nth(args) { return switch [args[0], args[1]] { case [seq, MalInt(idx)]: @@ -366,6 +377,8 @@ class Core { "sequential?" => sequential_Q, "cons" => cons, "concat" => do_concat, + "vec" => do_vec, + "nth" => nth, "first" => function(a) { return first(a[0]); }, "rest" => function(a) { return rest(a[0]); }, diff --git a/impls/hy/core.hy b/impls/hy/core.hy index b78dfd8c..79b063b4 100644 --- a/impls/hy/core.hy +++ b/impls/hy/core.hy @@ -73,6 +73,7 @@ "sequential?" sequential? "cons" (fn [a b] (tuple (chain [a] b))) "concat" (fn [&rest a] (tuple (apply chain a))) + "vec" (fn [a] (list a)) "nth" (fn [a b] (get a b)) "first" (fn [a] (if (none? a) None (first a))) "rest" (fn [a] (if (none? a) (,) (tuple (rest a)))) diff --git a/impls/hy/step7_quote.hy b/impls/hy/step7_quote.hy index 38ca94e2..9f4e52f7 100755 --- a/impls/hy/step7_quote.hy +++ b/impls/hy/step7_quote.hy @@ -13,23 +13,23 @@ (read-str str)) ;; eval -(defn pair? [x] - (and (core.sequential? x) (> (len x) 0))) - +(defn qq-loop [elt acc] + (if (and (instance? tuple elt) + (= (first elt) (Sym "splice-unquote"))) + (tuple [(Sym "concat") (get elt 1) acc]) + (tuple [(Sym "cons") (QUASIQUOTE elt) acc]))) +(defn qq-foldr [xs] + (if (empty? xs) + (,) + (qq-loop (first xs) (qq-foldr (tuple (rest xs)))))) (defn QUASIQUOTE [ast] (if - (not (pair? ast)) - (tuple [(Sym "quote") ast]) - - (= (Sym "unquote") (first ast)) - (nth ast 1) - - (and (pair? (first ast)) - (= (Sym "splice-unquote") (first (first ast)))) - (tuple [(Sym "concat") (nth (first ast) 1) (QUASIQUOTE (tuple (rest ast)))]) - - True - (tuple [(Sym "cons") (QUASIQUOTE (first ast)) (QUASIQUOTE (tuple (rest ast)))]))) + (instance? list ast) (tuple [(Sym "vec") (qq-foldr ast)]) + (symbol? ast) (tuple [(Sym "quote") ast]) + (instance? dict ast) (tuple [(Sym "quote") ast]) + (not (instance? tuple ast)) ast + (= (first ast) (Sym "unquote")) (get ast 1) + True (qq-foldr ast))) (defn eval-ast [ast env] ;;(print "eval-ast:" ast (type ast)) @@ -72,6 +72,9 @@ (= (Sym "quote") a0) a1 + (= (Sym "quasiquoteexpand") a0) + (QUASIQUOTE a1) + (= (Sym "quasiquote") a0) (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO diff --git a/impls/hy/step8_macros.hy b/impls/hy/step8_macros.hy index 2e202b32..e2462bd7 100755 --- a/impls/hy/step8_macros.hy +++ b/impls/hy/step8_macros.hy @@ -13,23 +13,23 @@ (read-str str)) ;; eval -(defn pair? [x] - (and (core.sequential? x) (> (len x) 0))) - +(defn qq-loop [elt acc] + (if (and (instance? tuple elt) + (= (first elt) (Sym "splice-unquote"))) + (tuple [(Sym "concat") (get elt 1) acc]) + (tuple [(Sym "cons") (QUASIQUOTE elt) acc]))) +(defn qq-foldr [xs] + (if (empty? xs) + (,) + (qq-loop (first xs) (qq-foldr (tuple (rest xs)))))) (defn QUASIQUOTE [ast] (if - (not (pair? ast)) - (tuple [(Sym "quote") ast]) - - (= (Sym "unquote") (first ast)) - (nth ast 1) - - (and (pair? (first ast)) - (= (Sym "splice-unquote") (first (first ast)))) - (tuple [(Sym "concat") (nth (first ast) 1) (QUASIQUOTE (tuple (rest ast)))]) - - True - (tuple [(Sym "cons") (QUASIQUOTE (first ast)) (QUASIQUOTE (tuple (rest ast)))]))) + (instance? list ast) (tuple [(Sym "vec") (qq-foldr ast)]) + (symbol? ast) (tuple [(Sym "quote") ast]) + (instance? dict ast) (tuple [(Sym "quote") ast]) + (not (instance? tuple ast)) ast + (= (first ast) (Sym "unquote")) (get ast 1) + True (qq-foldr ast))) (defn macro? [ast env] (when (and (coll? ast) @@ -92,6 +92,9 @@ (= (Sym "quote") a0) a1 + (= (Sym "quasiquoteexpand") a0) + (QUASIQUOTE a1) + (= (Sym "quasiquote") a0) (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO diff --git a/impls/hy/step9_try.hy b/impls/hy/step9_try.hy index 6a078d23..bab229b1 100755 --- a/impls/hy/step9_try.hy +++ b/impls/hy/step9_try.hy @@ -13,23 +13,23 @@ (read-str str)) ;; eval -(defn pair? [x] - (and (core.sequential? x) (> (len x) 0))) - +(defn qq-loop [elt acc] + (if (and (instance? tuple elt) + (= (first elt) (Sym "splice-unquote"))) + (tuple [(Sym "concat") (get elt 1) acc]) + (tuple [(Sym "cons") (QUASIQUOTE elt) acc]))) +(defn qq-foldr [xs] + (if (empty? xs) + (,) + (qq-loop (first xs) (qq-foldr (tuple (rest xs)))))) (defn QUASIQUOTE [ast] (if - (not (pair? ast)) - (tuple [(Sym "quote") ast]) - - (= (Sym "unquote") (first ast)) - (nth ast 1) - - (and (pair? (first ast)) - (= (Sym "splice-unquote") (first (first ast)))) - (tuple [(Sym "concat") (nth (first ast) 1) (QUASIQUOTE (tuple (rest ast)))]) - - True - (tuple [(Sym "cons") (QUASIQUOTE (first ast)) (QUASIQUOTE (tuple (rest ast)))]))) + (instance? list ast) (tuple [(Sym "vec") (qq-foldr ast)]) + (symbol? ast) (tuple [(Sym "quote") ast]) + (instance? dict ast) (tuple [(Sym "quote") ast]) + (not (instance? tuple ast)) ast + (= (first ast) (Sym "unquote")) (get ast 1) + True (qq-foldr ast))) (defn macro? [ast env] (when (and (coll? ast) @@ -92,6 +92,9 @@ (= (Sym "quote") a0) a1 + (= (Sym "quasiquoteexpand") a0) + (QUASIQUOTE a1) + (= (Sym "quasiquote") a0) (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO diff --git a/impls/hy/stepA_mal.hy b/impls/hy/stepA_mal.hy index 00bfeca5..50ec0763 100755 --- a/impls/hy/stepA_mal.hy +++ b/impls/hy/stepA_mal.hy @@ -13,23 +13,23 @@ (read-str str)) ;; eval -(defn pair? [x] - (and (core.sequential? x) (> (len x) 0))) - +(defn qq-loop [elt acc] + (if (and (instance? tuple elt) + (= (first elt) (Sym "splice-unquote"))) + (tuple [(Sym "concat") (get elt 1) acc]) + (tuple [(Sym "cons") (QUASIQUOTE elt) acc]))) +(defn qq-foldr [xs] + (if (empty? xs) + (,) + (qq-loop (first xs) (qq-foldr (tuple (rest xs)))))) (defn QUASIQUOTE [ast] (if - (not (pair? ast)) - (tuple [(Sym "quote") ast]) - - (= (Sym "unquote") (first ast)) - (nth ast 1) - - (and (pair? (first ast)) - (= (Sym "splice-unquote") (first (first ast)))) - (tuple [(Sym "concat") (nth (first ast) 1) (QUASIQUOTE (tuple (rest ast)))]) - - True - (tuple [(Sym "cons") (QUASIQUOTE (first ast)) (QUASIQUOTE (tuple (rest ast)))]))) + (instance? list ast) (tuple [(Sym "vec") (qq-foldr ast)]) + (symbol? ast) (tuple [(Sym "quote") ast]) + (instance? dict ast) (tuple [(Sym "quote") ast]) + (not (instance? tuple ast)) ast + (= (first ast) (Sym "unquote")) (get ast 1) + True (qq-foldr ast))) (defn macro? [ast env] (when (and (coll? ast) @@ -92,6 +92,9 @@ (= (Sym "quote") a0) a1 + (= (Sym "quasiquoteexpand") a0) + (QUASIQUOTE a1) + (= (Sym "quasiquote") a0) (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO diff --git a/impls/io/MalCore.io b/impls/io/MalCore.io index 9841996e..740e2c61 100644 --- a/impls/io/MalCore.io +++ b/impls/io/MalCore.io @@ -12,6 +12,13 @@ MalCore := Object clone do( res ) + vec := block(a, + coll := a at(0) + coll type switch( + "MalVector", coll, + "MalList", MalVector with(coll), + Exception raise("vec: arg type"))) + nth := block(a, if(a at(1) < a at(0) size, a at(0) at(a at(1)), @@ -122,6 +129,7 @@ MalCore := Object clone do( "sequential?", block(a, if(a at(0) ?isSequential, true, false)), "cons", block(a, MalList with(list(a at(0)) appendSeq(a at(1)))), "concat", block(a, MalList with(a reduce(appendSeq, list()))), + "vec", vec, "nth", nth, "first", block(a, a at(0) ifNil(return nil) first), "rest", block(a, a at(0) ifNil(return MalList with(list())) rest), diff --git a/impls/io/step7_quote.io b/impls/io/step7_quote.io index 4f756a35..0d05523d 100644 --- a/impls/io/step7_quote.io +++ b/impls/io/step7_quote.io @@ -3,18 +3,22 @@ MalReader READ := method(str, MalReader read_str(str)) -isPair := method(obj, - obj ?isSequential and(obj isEmpty not) -) +qq_foldr := method(xs, + xs reverseReduce(acc, elt, + if((elt type == "MalList") and (elt size == 2) and (elt at(0) == MalSymbol with("splice-unquote")), + MalList with(list(MalSymbol with("concat"), elt at(1), acc)), + MalList with(list(MalSymbol with("cons"), quasiquote(elt), acc))), + MalList with(list()))) quasiquote := method(ast, - if(isPair(ast) not, return(MalList with(list(MalSymbol with("quote"), ast)))) - a0 := ast at(0) - if(a0 == MalSymbol with("unquote"), return(ast at(1))) - if(isPair(a0) and (a0 at(0) == MalSymbol with("splice-unquote")), - return(MalList with(list(MalSymbol with("concat"), a0 at(1), quasiquote(ast rest)))), - return(MalList with(list(MalSymbol with("cons"), quasiquote(a0), quasiquote(ast rest))))) -) + ast type switch( + "MalSymbol", MalList with(list(MalSymbol with("quote"), ast)), + "MalMap", MalList with(list(MalSymbol with("quote"), ast)), + "MalVector", MalList with(list(MalSymbol with("vec"), qq_foldr(ast))), + "MalList", if((ast size == 2) and (ast at(0) == MalSymbol with("unquote")), + ast at(1), + qq_foldr(ast)), + ast)) eval_ast := method(ast, env, (ast type) switch( @@ -63,6 +67,8 @@ EVAL := method(ast, env, continue, // TCO "quote", return(ast at(1)), + "quasiquoteexpand", + return quasiquote(ast at(1)), "quasiquote", ast = quasiquote(ast at(1)) continue // TCO diff --git a/impls/io/step8_macros.io b/impls/io/step8_macros.io index 7f4ccb28..5f974ca2 100644 --- a/impls/io/step8_macros.io +++ b/impls/io/step8_macros.io @@ -3,18 +3,22 @@ MalReader READ := method(str, MalReader read_str(str)) -isPair := method(obj, - obj ?isSequential and(obj isEmpty not) -) +qq_foldr := method(xs, + xs reverseReduce(acc, elt, + if((elt type == "MalList") and (elt size == 2) and (elt at(0) == MalSymbol with("splice-unquote")), + MalList with(list(MalSymbol with("concat"), elt at(1), acc)), + MalList with(list(MalSymbol with("cons"), quasiquote(elt), acc))), + MalList with(list()))) quasiquote := method(ast, - if(isPair(ast) not, return(MalList with(list(MalSymbol with("quote"), ast)))) - a0 := ast at(0) - if(a0 == MalSymbol with("unquote"), return(ast at(1))) - if(isPair(a0) and (a0 at(0) == MalSymbol with("splice-unquote")), - return(MalList with(list(MalSymbol with("concat"), a0 at(1), quasiquote(ast rest)))), - return(MalList with(list(MalSymbol with("cons"), quasiquote(a0), quasiquote(ast rest))))) -) + ast type switch( + "MalSymbol", MalList with(list(MalSymbol with("quote"), ast)), + "MalMap", MalList with(list(MalSymbol with("quote"), ast)), + "MalVector", MalList with(list(MalSymbol with("vec"), qq_foldr(ast))), + "MalList", if((ast size == 2) and (ast at(0) == MalSymbol with("unquote")), + ast at(1), + qq_foldr(ast)), + ast)) isMacroCall := method(ast, env, if(ast type != "MalList", return false) @@ -84,6 +88,8 @@ EVAL := method(ast, env, continue, // TCO "quote", return(ast at(1)), + "quasiquoteexpand", + return quasiquote(ast at(1)), "quasiquote", ast = quasiquote(ast at(1)) continue, // TCO diff --git a/impls/io/step9_try.io b/impls/io/step9_try.io index 06941388..11f2852c 100644 --- a/impls/io/step9_try.io +++ b/impls/io/step9_try.io @@ -3,18 +3,22 @@ MalReader READ := method(str, MalReader read_str(str)) -isPair := method(obj, - obj ?isSequential and(obj isEmpty not) -) +qq_foldr := method(xs, + xs reverseReduce(acc, elt, + if((elt type == "MalList") and (elt size == 2) and (elt at(0) == MalSymbol with("splice-unquote")), + MalList with(list(MalSymbol with("concat"), elt at(1), acc)), + MalList with(list(MalSymbol with("cons"), quasiquote(elt), acc))), + MalList with(list()))) quasiquote := method(ast, - if(isPair(ast) not, return(MalList with(list(MalSymbol with("quote"), ast)))) - a0 := ast at(0) - if(a0 == MalSymbol with("unquote"), return(ast at(1))) - if(isPair(a0) and (a0 at(0) == MalSymbol with("splice-unquote")), - return(MalList with(list(MalSymbol with("concat"), a0 at(1), quasiquote(ast rest)))), - return(MalList with(list(MalSymbol with("cons"), quasiquote(a0), quasiquote(ast rest))))) -) + ast type switch( + "MalSymbol", MalList with(list(MalSymbol with("quote"), ast)), + "MalMap", MalList with(list(MalSymbol with("quote"), ast)), + "MalVector", MalList with(list(MalSymbol with("vec"), qq_foldr(ast))), + "MalList", if((ast size == 2) and (ast at(0) == MalSymbol with("unquote")), + ast at(1), + qq_foldr(ast)), + ast)) isMacroCall := method(ast, env, if(ast type != "MalList", return false) @@ -84,6 +88,8 @@ EVAL := method(ast, env, continue, // TCO "quote", return(ast at(1)), + "quasiquoteexpand", + return quasiquote(ast at(1)), "quasiquote", ast = quasiquote(ast at(1)) continue, // TCO diff --git a/impls/io/stepA_mal.io b/impls/io/stepA_mal.io index 70b042f4..85683931 100644 --- a/impls/io/stepA_mal.io +++ b/impls/io/stepA_mal.io @@ -3,18 +3,22 @@ MalReader READ := method(str, MalReader read_str(str)) -isPair := method(obj, - obj ?isSequential and(obj isEmpty not) -) +qq_foldr := method(xs, + xs reverseReduce(acc, elt, + if((elt type == "MalList") and (elt size == 2) and (elt at(0) == MalSymbol with("splice-unquote")), + MalList with(list(MalSymbol with("concat"), elt at(1), acc)), + MalList with(list(MalSymbol with("cons"), quasiquote(elt), acc))), + MalList with(list()))) quasiquote := method(ast, - if(isPair(ast) not, return(MalList with(list(MalSymbol with("quote"), ast)))) - a0 := ast at(0) - if(a0 == MalSymbol with("unquote"), return(ast at(1))) - if(isPair(a0) and (a0 at(0) == MalSymbol with("splice-unquote")), - return(MalList with(list(MalSymbol with("concat"), a0 at(1), quasiquote(ast rest)))), - return(MalList with(list(MalSymbol with("cons"), quasiquote(a0), quasiquote(ast rest))))) -) + ast type switch( + "MalSymbol", MalList with(list(MalSymbol with("quote"), ast)), + "MalMap", MalList with(list(MalSymbol with("quote"), ast)), + "MalVector", MalList with(list(MalSymbol with("vec"), qq_foldr(ast))), + "MalList", if((ast size == 2) and (ast at(0) == MalSymbol with("unquote")), + ast at(1), + qq_foldr(ast)), + ast)) isMacroCall := method(ast, env, if(ast type != "MalList", return false) @@ -84,6 +88,8 @@ EVAL := method(ast, env, continue, // TCO "quote", return(ast at(1)), + "quasiquoteexpand", + return quasiquote(ast at(1)), "quasiquote", ast = quasiquote(ast at(1)) continue, // TCO diff --git a/impls/java/src/main/java/mal/core.java b/impls/java/src/main/java/mal/core.java index 23843b8a..977d5ab8 100644 --- a/impls/java/src/main/java/mal/core.java +++ b/impls/java/src/main/java/mal/core.java @@ -395,6 +395,12 @@ public class core { } }; + static MalFunction vec = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return new MalVector(((MalList)a.nth(0)).getList()); + } + }; + static MalFunction first = new MalFunction() { public MalVal apply(MalList a) throws MalThrowable { MalVal exp = a.nth(0); @@ -604,6 +610,7 @@ public class core { .put("sequential?", sequential_Q) .put("cons", cons) .put("concat", concat) + .put("vec", vec) .put("nth", nth) .put("first", first) .put("rest", rest) diff --git a/impls/java/src/main/java/mal/step7_quote.java b/impls/java/src/main/java/mal/step7_quote.java index 41400992..b82a64a1 100644 --- a/impls/java/src/main/java/mal/step7_quote.java +++ b/impls/java/src/main/java/mal/step7_quote.java @@ -20,31 +20,36 @@ public class step7_quote { } // eval - public static Boolean is_pair(MalVal x) { - return x instanceof MalList && ((MalList)x).size() > 0; + public static Boolean starts_with(MalVal ast, String sym) { + // Liskov, forgive me + if (ast instanceof MalList && !(ast instanceof MalVector) && ((MalList)ast).size() == 2) { + MalVal a0 = ((MalList)ast).nth(0); + return a0 instanceof MalSymbol && ((MalSymbol)a0).getName().equals(sym); + } + return false; } public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { + if ((ast instanceof MalSymbol || ast instanceof MalHashMap)) return new MalList(new MalSymbol("quote"), ast); - } else { - MalVal a0 = ((MalList)ast).nth(0); - if ((a0 instanceof MalSymbol) && - (((MalSymbol)a0).getName().equals("unquote"))) { - return ((MalList)ast).nth(1); - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0).nth(0); - if ((a00 instanceof MalSymbol) && - (((MalSymbol)a00).getName().equals("splice-unquote"))) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0).nth(1), - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); + + if (!(ast instanceof MalList)) + return ast; + + if (starts_with(ast, "unquote")) + return ((MalList)ast).nth(1); + + MalVal res = new MalList(); + for (Integer i=((MalList)ast).size()-1; 0<=i; i--) { + MalVal elt = ((MalList)ast).nth(i); + if (starts_with(elt, "splice-unquote")) + res = new MalList(new MalSymbol("concat"), ((MalList)elt).nth(1), res); + else + res = new MalList(new MalSymbol("cons"), quasiquote(elt), res); } + if (ast instanceof MalVector) + res = new MalList(new MalSymbol("vec"), res); + return res; } public static MalVal eval_ast(MalVal ast, Env env) throws MalThrowable { @@ -111,6 +116,8 @@ public class step7_quote { break; case "quote": return ast.nth(1); + case "quasiquoteexpand": + return quasiquote(ast.nth(1)); case "quasiquote": orig_ast = quasiquote(ast.nth(1)); break; diff --git a/impls/java/src/main/java/mal/step8_macros.java b/impls/java/src/main/java/mal/step8_macros.java index 5b319537..9e2a93a5 100644 --- a/impls/java/src/main/java/mal/step8_macros.java +++ b/impls/java/src/main/java/mal/step8_macros.java @@ -20,31 +20,36 @@ public class step8_macros { } // eval - public static Boolean is_pair(MalVal x) { - return x instanceof MalList && ((MalList)x).size() > 0; + public static Boolean starts_with(MalVal ast, String sym) { + // Liskov, forgive me + if (ast instanceof MalList && !(ast instanceof MalVector) && ((MalList)ast).size() == 2) { + MalVal a0 = ((MalList)ast).nth(0); + return a0 instanceof MalSymbol && ((MalSymbol)a0).getName().equals(sym); + } + return false; } public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { + if ((ast instanceof MalSymbol || ast instanceof MalHashMap)) return new MalList(new MalSymbol("quote"), ast); - } else { - MalVal a0 = ((MalList)ast).nth(0); - if ((a0 instanceof MalSymbol) && - (((MalSymbol)a0).getName().equals("unquote"))) { - return ((MalList)ast).nth(1); - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0).nth(0); - if ((a00 instanceof MalSymbol) && - (((MalSymbol)a00).getName().equals("splice-unquote"))) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0).nth(1), - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); + + if (!(ast instanceof MalList)) + return ast; + + if (starts_with(ast, "unquote")) + return ((MalList)ast).nth(1); + + MalVal res = new MalList(); + for (Integer i=((MalList)ast).size()-1; 0<=i; i--) { + MalVal elt = ((MalList)ast).nth(i); + if (starts_with(elt, "splice-unquote")) + res = new MalList(new MalSymbol("concat"), ((MalList)elt).nth(1), res); + else + res = new MalList(new MalSymbol("cons"), quasiquote(elt), res); } + if (ast instanceof MalVector) + res = new MalList(new MalSymbol("vec"), res); + return res; } public static Boolean is_macro_call(MalVal ast, Env env) @@ -142,6 +147,8 @@ public class step8_macros { break; case "quote": return ast.nth(1); + case "quasiquoteexpand": + return quasiquote(ast.nth(1)); case "quasiquote": orig_ast = quasiquote(ast.nth(1)); break; diff --git a/impls/java/src/main/java/mal/step9_try.java b/impls/java/src/main/java/mal/step9_try.java index bd5bec05..8e262119 100644 --- a/impls/java/src/main/java/mal/step9_try.java +++ b/impls/java/src/main/java/mal/step9_try.java @@ -22,31 +22,36 @@ public class step9_try { } // eval - public static Boolean is_pair(MalVal x) { - return x instanceof MalList && ((MalList)x).size() > 0; + public static Boolean starts_with(MalVal ast, String sym) { + // Liskov, forgive me + if (ast instanceof MalList && !(ast instanceof MalVector) && ((MalList)ast).size() == 2) { + MalVal a0 = ((MalList)ast).nth(0); + return a0 instanceof MalSymbol && ((MalSymbol)a0).getName().equals(sym); + } + return false; } public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { + if ((ast instanceof MalSymbol || ast instanceof MalHashMap)) return new MalList(new MalSymbol("quote"), ast); - } else { - MalVal a0 = ((MalList)ast).nth(0); - if ((a0 instanceof MalSymbol) && - (((MalSymbol)a0).getName().equals("unquote"))) { - return ((MalList)ast).nth(1); - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0).nth(0); - if ((a00 instanceof MalSymbol) && - (((MalSymbol)a00).getName().equals("splice-unquote"))) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0).nth(1), - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); + + if (!(ast instanceof MalList)) + return ast; + + if (starts_with(ast, "unquote")) + return ((MalList)ast).nth(1); + + MalVal res = new MalList(); + for (Integer i=((MalList)ast).size()-1; 0<=i; i--) { + MalVal elt = ((MalList)ast).nth(i); + if (starts_with(elt, "splice-unquote")) + res = new MalList(new MalSymbol("concat"), ((MalList)elt).nth(1), res); + else + res = new MalList(new MalSymbol("cons"), quasiquote(elt), res); } + if (ast instanceof MalVector) + res = new MalList(new MalSymbol("vec"), res); + return res; } public static Boolean is_macro_call(MalVal ast, Env env) @@ -144,6 +149,8 @@ public class step9_try { break; case "quote": return ast.nth(1); + case "quasiquoteexpand": + return quasiquote(ast.nth(1)); case "quasiquote": orig_ast = quasiquote(ast.nth(1)); break; diff --git a/impls/java/src/main/java/mal/stepA_mal.java b/impls/java/src/main/java/mal/stepA_mal.java index 6e5dc36a..498bc930 100644 --- a/impls/java/src/main/java/mal/stepA_mal.java +++ b/impls/java/src/main/java/mal/stepA_mal.java @@ -22,31 +22,36 @@ public class stepA_mal { } // eval - public static Boolean is_pair(MalVal x) { - return x instanceof MalList && ((MalList)x).size() > 0; + public static Boolean starts_with(MalVal ast, String sym) { + // Liskov, forgive me + if (ast instanceof MalList && !(ast instanceof MalVector) && ((MalList)ast).size() == 2) { + MalVal a0 = ((MalList)ast).nth(0); + return a0 instanceof MalSymbol && ((MalSymbol)a0).getName().equals(sym); + } + return false; } public static MalVal quasiquote(MalVal ast) { - if (!is_pair(ast)) { + if ((ast instanceof MalSymbol || ast instanceof MalHashMap)) return new MalList(new MalSymbol("quote"), ast); - } else { - MalVal a0 = ((MalList)ast).nth(0); - if ((a0 instanceof MalSymbol) && - (((MalSymbol)a0).getName().equals("unquote"))) { - return ((MalList)ast).nth(1); - } else if (is_pair(a0)) { - MalVal a00 = ((MalList)a0).nth(0); - if ((a00 instanceof MalSymbol) && - (((MalSymbol)a00).getName().equals("splice-unquote"))) { - return new MalList(new MalSymbol("concat"), - ((MalList)a0).nth(1), - quasiquote(((MalList)ast).rest())); - } - } - return new MalList(new MalSymbol("cons"), - quasiquote(a0), - quasiquote(((MalList)ast).rest())); + + if (!(ast instanceof MalList)) + return ast; + + if (starts_with(ast, "unquote")) + return ((MalList)ast).nth(1); + + MalVal res = new MalList(); + for (Integer i=((MalList)ast).size()-1; 0<=i; i--) { + MalVal elt = ((MalList)ast).nth(i); + if (starts_with(elt, "splice-unquote")) + res = new MalList(new MalSymbol("concat"), ((MalList)elt).nth(1), res); + else + res = new MalList(new MalSymbol("cons"), quasiquote(elt), res); } + if (ast instanceof MalVector) + res = new MalList(new MalSymbol("vec"), res); + return res; } public static Boolean is_macro_call(MalVal ast, Env env) @@ -144,6 +149,8 @@ public class stepA_mal { break; case "quote": return ast.nth(1); + case "quasiquoteexpand": + return quasiquote(ast.nth(1)); case "quasiquote": orig_ast = quasiquote(ast.nth(1)); break; diff --git a/impls/jq/core.jq b/impls/jq/core.jq index 2ba743a9..87d6385c 100644 --- a/impls/jq/core.jq +++ b/impls/jq/core.jq @@ -119,6 +119,11 @@ def core_identify: function: "concat", inputs: -1 }, + "vec": { + kind: "fn", + function: "vec", + inputs: 1 + }, "nth": { kind: "fn", function: "nth", @@ -373,6 +378,8 @@ def core_interp(arguments; env): select(.function == "cons") | ([arguments[0]] + arguments[1].value) | wrap("list") ) // ( select(.function == "concat") | arguments | map(.value) | (add//[]) | wrap("list") + ) // ( + select(.function == "vec") | {kind:"vector", value:arguments[0].value} ) // ( select(.function == "nth") | _debug(arguments) diff --git a/impls/jq/step7_quote.jq b/impls/jq/step7_quote.jq index 5e9e15a3..bd7ddfdf 100644 --- a/impls/jq/step7_quote.jq +++ b/impls/jq/step7_quote.jq @@ -39,25 +39,39 @@ def _symbol_v(name): end; def quasiquote: - if isPair then - .value as $value | null | - if ($value[0] | _symbol_v("unquote")) then - $value[1] - else - if isPair($value[0]) and ($value[0].value[0] | _symbol_v("splice-unquote")) then - [_symbol("concat")] + - [$value[0].value[1]] + - [($value[1:] | wrap("list") | quasiquote)] | wrap("list") - else - [_symbol("cons")] + - [($value[0] | quasiquote)] + - [($value[1:] | wrap("list") | quasiquote)] | wrap("list") - end - end - else - [_symbol("quote")] + - [.] | wrap("list") - end; + + # If input is ('name, arg), return arg, else nothing. + def _starts_with(name): + select(.kind == "list") + | .value + | select(length == 2) + | select(.[0] | _symbol_v(name)) + | .[1]; + + # Right-folding function. The current element is provided as input. + def qq_loop(acc): + ((_starts_with("splice-unquote") | [_symbol("concat"), ., acc]) + // [_symbol("cons"), quasiquote, acc]) + | {kind:"list", value:.}; + + # Adapt parameters for jq foldr. + def qq_foldr: + .value + | reverse + | reduce .[] as $elt ({kind:"list", value:[]}; + . as $acc | $elt | qq_loop($acc)); + + _starts_with("unquote") + // ( + select(.kind == "list") + | qq_foldr + ) // ( + select(.kind == "vector") + | {kind:"list", value:[_symbol("vec"), qq_foldr]} + ) // ( + select(.kind == "hashmap" or .kind == "symbol") + | {kind:"list", value:[_symbol("quote"), .]} + ) // .; def EVAL(env): def _eval_here: @@ -159,6 +173,10 @@ def EVAL(env): .value | select(.[0].value == "quote") as $value | $value[1] | TCOWrap($_menv; $_orig_retenv; false) ) // + ( + .value | select(.[0].value == "quasiquoteexpand") + | .[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; false) + ) // ( .value | select(.[0].value == "quasiquote") as $value | $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true) diff --git a/impls/jq/step8_macros.jq b/impls/jq/step8_macros.jq index 9af09fdc..75c18c51 100644 --- a/impls/jq/step8_macros.jq +++ b/impls/jq/step8_macros.jq @@ -39,25 +39,39 @@ def _symbol_v(name): end; def quasiquote: - if isPair then - .value as $value | null | - if ($value[0] | _symbol_v("unquote")) then - $value[1] - else - if isPair($value[0]) and ($value[0].value[0] | _symbol_v("splice-unquote")) then - [_symbol("concat")] + - [$value[0].value[1]] + - [($value[1:] | wrap("list") | quasiquote)] | wrap("list") - else - [_symbol("cons")] + - [($value[0] | quasiquote)] + - [($value[1:] | wrap("list") | quasiquote)] | wrap("list") - end - end - else - [_symbol("quote")] + - [.] | wrap("list") - end; + + # If input is ('name, arg), return arg, else nothing. + def _starts_with(name): + select(.kind == "list") + | .value + | select(length == 2) + | select(.[0] | _symbol_v(name)) + | .[1]; + + # Right-folding function. The current element is provided as input. + def qq_loop(acc): + ((_starts_with("splice-unquote") | [_symbol("concat"), ., acc]) + // [_symbol("cons"), quasiquote, acc]) + | {kind:"list", value:.}; + + # Adapt parameters for jq foldr. + def qq_foldr: + .value + | reverse + | reduce .[] as $elt ({kind:"list", value:[]}; + . as $acc | $elt | qq_loop($acc)); + + _starts_with("unquote") + // ( + select(.kind == "list") + | qq_foldr + ) // ( + select(.kind == "vector") + | {kind:"list", value:[_symbol("vec"), qq_foldr]} + ) // ( + select(.kind == "hashmap" or .kind == "symbol") + | {kind:"list", value:[_symbol("quote"), .]} + ) // .; def set_macro_function: if .kind != "function" then @@ -252,6 +266,10 @@ def EVAL(env): .value | select(.[0].value == "quote") as $value | $value[1] | TCOWrap($_menv; $_orig_retenv; false) ) // + ( + .value | select(.[0].value == "quasiquoteexpand") + | .[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; false) + ) // ( .value | select(.[0].value == "quasiquote") as $value | $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true) diff --git a/impls/jq/step9_try.jq b/impls/jq/step9_try.jq index a1b6657e..9c3d416f 100644 --- a/impls/jq/step9_try.jq +++ b/impls/jq/step9_try.jq @@ -39,25 +39,39 @@ def _symbol_v(name): end; def quasiquote: - if isPair then - .value as $value | null | - if ($value[0] | _symbol_v("unquote")) then - $value[1] - else - if isPair($value[0]) and ($value[0].value[0] | _symbol_v("splice-unquote")) then - [_symbol("concat")] + - [$value[0].value[1]] + - [($value[1:] | wrap("list") | quasiquote)] | wrap("list") - else - [_symbol("cons")] + - [($value[0] | quasiquote)] + - [($value[1:] | wrap("list") | quasiquote)] | wrap("list") - end - end - else - [_symbol("quote")] + - [.] | wrap("list") - end; + + # If input is ('name, arg), return arg, else nothing. + def _starts_with(name): + select(.kind == "list") + | .value + | select(length == 2) + | select(.[0] | _symbol_v(name)) + | .[1]; + + # Right-folding function. The current element is provided as input. + def qq_loop(acc): + ((_starts_with("splice-unquote") | [_symbol("concat"), ., acc]) + // [_symbol("cons"), quasiquote, acc]) + | {kind:"list", value:.}; + + # Adapt parameters for jq foldr. + def qq_foldr: + .value + | reverse + | reduce .[] as $elt ({kind:"list", value:[]}; + . as $acc | $elt | qq_loop($acc)); + + _starts_with("unquote") + // ( + select(.kind == "list") + | qq_foldr + ) // ( + select(.kind == "vector") + | {kind:"list", value:[_symbol("vec"), qq_foldr]} + ) // ( + select(.kind == "hashmap" or .kind == "symbol") + | {kind:"list", value:[_symbol("quote"), .]} + ) // .; def set_macro_function: if .kind != "function" then @@ -281,6 +295,10 @@ def EVAL(env): .value | select(.[0].value == "quote") as $value | $value[1] | TCOWrap($_menv; $_orig_retenv; false) ) // + ( + .value | select(.[0].value == "quasiquoteexpand") + | .[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; false) + ) // ( .value | select(.[0].value == "quasiquote") as $value | $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true) diff --git a/impls/jq/stepA_mal.jq b/impls/jq/stepA_mal.jq index 9f2793f3..0c794f37 100644 --- a/impls/jq/stepA_mal.jq +++ b/impls/jq/stepA_mal.jq @@ -39,25 +39,39 @@ def _symbol_v(name): end; def quasiquote: - if isPair then - .value as $value | null | - if ($value[0] | _symbol_v("unquote")) then - $value[1] - else - if isPair($value[0]) and ($value[0].value[0] | _symbol_v("splice-unquote")) then - [_symbol("concat")] + - [$value[0].value[1]] + - [($value[1:] | wrap("list") | quasiquote)] | wrap("list") - else - [_symbol("cons")] + - [($value[0] | quasiquote)] + - [($value[1:] | wrap("list") | quasiquote)] | wrap("list") - end - end - else - [_symbol("quote")] + - [.] | wrap("list") - end; + + # If input is ('name, arg), return arg, else nothing. + def _starts_with(name): + select(.kind == "list") + | .value + | select(length == 2) + | select(.[0] | _symbol_v(name)) + | .[1]; + + # Right-folding function. The current element is provided as input. + def qq_loop(acc): + ((_starts_with("splice-unquote") | [_symbol("concat"), ., acc]) + // [_symbol("cons"), quasiquote, acc]) + | {kind:"list", value:.}; + + # Adapt parameters for jq foldr. + def qq_foldr: + .value + | reverse + | reduce .[] as $elt ({kind:"list", value:[]}; + . as $acc | $elt | qq_loop($acc)); + + _starts_with("unquote") + // ( + select(.kind == "list") + | qq_foldr + ) // ( + select(.kind == "vector") + | {kind:"list", value:[_symbol("vec"), qq_foldr]} + ) // ( + select(.kind == "hashmap" or .kind == "symbol") + | {kind:"list", value:[_symbol("quote"), .]} + ) // .; def set_macro_function: if .kind != "function" then @@ -287,6 +301,10 @@ def EVAL(env): .value | select(.[0].value == "quote") as $value | $value[1] | TCOWrap($_menv; $_orig_retenv; false) ) // + ( + .value | select(.[0].value == "quasiquoteexpand") + | .[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; false) + ) // ( .value | select(.[0].value == "quasiquote") as $value | $value[1] | quasiquote | TCOWrap($_menv; $_orig_retenv; true) diff --git a/impls/jq/utils.jq b/impls/jq/utils.jq index c55a07e9..7b0876b7 100644 --- a/impls/jq/utils.jq +++ b/impls/jq/utils.jq @@ -37,15 +37,6 @@ def wrap2(kind; opts): value: . }; -def isPair: - if (.kind == "list" or .kind == "vector") then - .value | length > 0 - else - false - end; - -def isPair(x): - x | isPair; def find_free_references(keys): def _refs: diff --git a/impls/js/core.js b/impls/js/core.js index 9eb3ca43..2df84831 100644 --- a/impls/js/core.js +++ b/impls/js/core.js @@ -95,6 +95,15 @@ function concat(lst) { lst = lst || []; return lst.concat.apply(lst, Array.prototype.slice.call(arguments, 1)); } +function vec(lst) { + if (types._list_Q(lst)) { + var v = Array.prototype.slice.call(lst, 0); + v.__isvector__ = true; + return v; + } else { + return lst; + } +} function nth(lst, idx) { if (idx < lst.length) { return lst[idx]; } @@ -236,6 +245,7 @@ var ns = {'type': types._obj_type, 'sequential?': types._sequential_Q, 'cons': cons, 'concat': concat, + 'vec': vec, 'nth': nth, 'first': first, 'rest': rest, diff --git a/impls/js/step7_quote.js b/impls/js/step7_quote.js index 216273c8..a14112fd 100644 --- a/impls/js/step7_quote.js +++ b/impls/js/step7_quote.js @@ -13,23 +13,26 @@ function READ(str) { } // eval -function is_pair(x) { - return types._sequential_Q(x) && x.length > 0; -} - -function quasiquote(ast) { - if (!is_pair(ast)) { - return [types._symbol("quote"), ast]; - } else if (types._symbol_Q(ast[0]) && ast[0].value === 'unquote') { - return ast[1]; - } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { - return [types._symbol("concat"), - ast[0][1], - quasiquote(ast.slice(1))]; +function qqLoop (acc, elt) { + if (types._list_Q(elt) && elt.length + && types._symbol_Q(elt[0]) && elt[0].value == 'splice-unquote') { + return [types._symbol("concat"), elt[1], acc]; } else { - return [types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast.slice(1))]; + return [types._symbol("cons"), quasiquote (elt), acc]; + } +} +function quasiquote(ast) { + if (types._list_Q(ast) && 0 0; -} - -function quasiquote(ast) { - if (!is_pair(ast)) { - return [types._symbol("quote"), ast]; - } else if (types._symbol_Q(ast[0]) && ast[0].value === 'unquote') { - return ast[1]; - } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { - return [types._symbol("concat"), - ast[0][1], - quasiquote(ast.slice(1))]; +function qqLoop (acc, elt) { + if (types._list_Q(elt) && elt.length + && types._symbol_Q(elt[0]) && elt[0].value == 'splice-unquote') { + return [types._symbol("concat"), elt[1], acc]; } else { - return [types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast.slice(1))]; + return [types._symbol("cons"), quasiquote (elt), acc]; + } +} +function quasiquote(ast) { + if (types._list_Q(ast) && 0 0; -} - -function quasiquote(ast) { - if (!is_pair(ast)) { - return [types._symbol("quote"), ast]; - } else if (types._symbol_Q(ast[0]) && ast[0].value === 'unquote') { - return ast[1]; - } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { - return [types._symbol("concat"), - ast[0][1], - quasiquote(ast.slice(1))]; +function qqLoop (acc, elt) { + if (types._list_Q(elt) && elt.length + && types._symbol_Q(elt[0]) && elt[0].value == 'splice-unquote') { + return [types._symbol("concat"), elt[1], acc]; } else { - return [types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast.slice(1))]; + return [types._symbol("cons"), quasiquote (elt), acc]; + } +} +function quasiquote(ast) { + if (types._list_Q(ast) && 0 0; -} - -function quasiquote(ast) { - if (!is_pair(ast)) { - return [types._symbol("quote"), ast]; - } else if (types._symbol_Q(ast[0]) && ast[0].value === 'unquote') { - return ast[1]; - } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { - return [types._symbol("concat"), - ast[0][1], - quasiquote(ast.slice(1))]; +function qqLoop (acc, elt) { + if (types._list_Q(elt) && elt.length + && types._symbol_Q(elt[0]) && elt[0].value == 'splice-unquote') { + return [types._symbol("concat"), elt[1], acc]; } else { - return [types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast.slice(1))]; + return [types._symbol("cons"), quasiquote (elt), acc]; + } +} +function quasiquote(ast) { + if (types._list_Q(ast) && 0 types.sequential_Q, :cons => (a,b) -> [Any[a]; Any[b...]], :concat => concat, + :vec => (a) -> tuple(a...), :nth => (a,b) -> b+1 > length(a) ? error("nth: index out of range") : a[b+1], :first => (a) -> a === nothing || isempty(a) ? nothing : first(a), :rest => (a) -> a === nothing ? Any[] : Any[a[2:end]...], diff --git a/impls/julia/step7_quote.jl b/impls/julia/step7_quote.jl index 91395bc2..1fa33438 100755 --- a/impls/julia/step7_quote.jl +++ b/impls/julia/step7_quote.jl @@ -14,19 +14,32 @@ function READ(str) end # EVAL -function ispair(ast) - (isa(ast, Array) || isa(ast, Tuple)) && length(ast) > 0 +function quasiquote_loop(elts) + acc = Any[] + for i in length(elts):-1:1 + elt = elts[i] + if isa(elt, Array) && length(elt) == 2 && elt[1] == symbol("splice-unquote") + acc = Any[:concat, elt[2], acc] + else + acc = Any[:cons, quasiquote(elt), acc] + end + end + return acc end function quasiquote(ast) - if !ispair(ast) - [[:quote]; Any[ast]] - elseif ast[1] == :unquote - ast[2] - elseif ispair(ast[1]) && ast[1][1] == symbol("splice-unquote") - [[:concat]; Any[ast[1][2]]; Any[quasiquote(ast[2:end])]] + if isa(ast, Array) + if length(ast) == 2 && ast[1] == symbol("unquote") + ast[2] + else + quasiquote_loop(ast) + end + elseif isa(ast, Tuple) + Any[:vec, quasiquote_loop(ast)] + elseif typeof(ast) == Symbol || isa(ast, Dict) + Any[:quote, ast] else - [[:cons]; Any[quasiquote(ast[1])]; Any[quasiquote(ast[2:end])]] + ast end end @@ -61,6 +74,8 @@ function EVAL(ast, env) # TCO loop elseif :quote == ast[1] return ast[2] + elseif :quasiquoteexpand == ast[1] + return quasiquote(ast[2]) elseif :quasiquote == ast[1] ast = quasiquote(ast[2]) # TCO loop diff --git a/impls/julia/step8_macros.jl b/impls/julia/step8_macros.jl index 7ca18bde..bbe9868a 100755 --- a/impls/julia/step8_macros.jl +++ b/impls/julia/step8_macros.jl @@ -14,19 +14,32 @@ function READ(str) end # EVAL -function ispair(ast) - (isa(ast, Array) || isa(ast, Tuple)) && length(ast) > 0 +function quasiquote_loop(elts) + acc = Any[] + for i in length(elts):-1:1 + elt = elts[i] + if isa(elt, Array) && length(elt) == 2 && elt[1] == symbol("splice-unquote") + acc = Any[:concat, elt[2], acc] + else + acc = Any[:cons, quasiquote(elt), acc] + end + end + return acc end function quasiquote(ast) - if !ispair(ast) - [[:quote]; Any[ast]] - elseif ast[1] == :unquote - ast[2] - elseif ispair(ast[1]) && ast[1][1] == symbol("splice-unquote") - [[:concat]; Any[ast[1][2]]; Any[quasiquote(ast[2:end])]] + if isa(ast, Array) + if length(ast) == 2 && ast[1] == symbol("unquote") + ast[2] + else + quasiquote_loop(ast) + end + elseif isa(ast, Tuple) + Any[:vec, quasiquote_loop(ast)] + elseif typeof(ast) == Symbol || isa(ast, Dict) + Any[:quote, ast] else - [[:cons]; Any[quasiquote(ast[1])]; Any[quasiquote(ast[2:end])]] + ast end end @@ -81,6 +94,8 @@ function EVAL(ast, env) # TCO loop elseif :quote == ast[1] return ast[2] + elseif :quasiquoteexpand == ast[1] + return quasiquote(ast[2]) elseif :quasiquote == ast[1] ast = quasiquote(ast[2]) # TCO loop diff --git a/impls/julia/step9_try.jl b/impls/julia/step9_try.jl index 26459b26..0b9fb11f 100755 --- a/impls/julia/step9_try.jl +++ b/impls/julia/step9_try.jl @@ -14,19 +14,32 @@ function READ(str) end # EVAL -function ispair(ast) - (isa(ast, Array) || isa(ast, Tuple)) && length(ast) > 0 +function quasiquote_loop(elts) + acc = Any[] + for i in length(elts):-1:1 + elt = elts[i] + if isa(elt, Array) && length(elt) == 2 && elt[1] == symbol("splice-unquote") + acc = Any[:concat, elt[2], acc] + else + acc = Any[:cons, quasiquote(elt), acc] + end + end + return acc end function quasiquote(ast) - if !ispair(ast) - [[:quote]; Any[ast]] - elseif ast[1] == :unquote - ast[2] - elseif ispair(ast[1]) && ast[1][1] == symbol("splice-unquote") - [[:concat]; Any[ast[1][2]]; Any[quasiquote(ast[2:end])]] + if isa(ast, Array) + if length(ast) == 2 && ast[1] == symbol("unquote") + ast[2] + else + quasiquote_loop(ast) + end + elseif isa(ast, Tuple) + Any[:vec, quasiquote_loop(ast)] + elseif typeof(ast) == Symbol || isa(ast, Dict) + Any[:quote, ast] else - [[:cons]; Any[quasiquote(ast[1])]; Any[quasiquote(ast[2:end])]] + ast end end @@ -81,6 +94,8 @@ function EVAL(ast, env) # TCO loop elseif :quote == ast[1] return ast[2] + elseif :quasiquoteexpand == ast[1] + return quasiquote(ast[2]) elseif :quasiquote == ast[1] ast = quasiquote(ast[2]) # TCO loop diff --git a/impls/julia/stepA_mal.jl b/impls/julia/stepA_mal.jl index 629c6980..4bf26808 100755 --- a/impls/julia/stepA_mal.jl +++ b/impls/julia/stepA_mal.jl @@ -14,19 +14,32 @@ function READ(str) end # EVAL -function ispair(ast) - (isa(ast, Array) || isa(ast, Tuple)) && length(ast) > 0 +function quasiquote_loop(elts) + acc = Any[] + for i in length(elts):-1:1 + elt = elts[i] + if isa(elt, Array) && length(elt) == 2 && elt[1] == symbol("splice-unquote") + acc = Any[:concat, elt[2], acc] + else + acc = Any[:cons, quasiquote(elt), acc] + end + end + return acc end function quasiquote(ast) - if !ispair(ast) - [[:quote]; Any[ast]] - elseif ast[1] == :unquote - ast[2] - elseif ispair(ast[1]) && ast[1][1] == symbol("splice-unquote") - [[:concat]; Any[ast[1][2]]; Any[quasiquote(ast[2:end])]] + if isa(ast, Array) + if length(ast) == 2 && ast[1] == symbol("unquote") + ast[2] + else + quasiquote_loop(ast) + end + elseif isa(ast, Tuple) + Any[:vec, quasiquote_loop(ast)] + elseif typeof(ast) == Symbol || isa(ast, Dict) + Any[:quote, ast] else - [[:cons]; Any[quasiquote(ast[1])]; Any[quasiquote(ast[2:end])]] + ast end end @@ -81,6 +94,8 @@ function EVAL(ast, env) # TCO loop elseif :quote == ast[1] return ast[2] + elseif :quasiquoteexpand == ast[1] + return quasiquote(ast[2]) elseif :quasiquote == ast[1] ast = quasiquote(ast[2]) # TCO loop diff --git a/impls/kotlin/src/mal/core.kt b/impls/kotlin/src/mal/core.kt index bc312c8b..e14b4150 100644 --- a/impls/kotlin/src/mal/core.kt +++ b/impls/kotlin/src/mal/core.kt @@ -54,7 +54,10 @@ val ns = hashMapOf( MalList(mutableList) }), envPair("concat", { a: ISeq -> MalList(a.seq().flatMap({ it -> (it as ISeq).seq() }).toCollection(LinkedList())) }), - + envPair("vec", { a: ISeq -> + val list = a.first() as? ISeq ?: throw MalException("vec requires a sequence") + MalVector(list) + }), envPair("nth", { a: ISeq -> val list = a.nth(0) as? ISeq ?: throw MalException("nth requires a list as its first parameter") val index = a.nth(1) as? MalInteger ?: throw MalException("nth requires an integer as its second parameter") diff --git a/impls/kotlin/src/mal/step7_quote.kt b/impls/kotlin/src/mal/step7_quote.kt index 5b0d3d01..9cb803fe 100644 --- a/impls/kotlin/src/mal/step7_quote.kt +++ b/impls/kotlin/src/mal/step7_quote.kt @@ -42,6 +42,7 @@ fun eval(_ast: MalType, _env: Env): MalType { } else return NIL } "quote" -> return ast.nth(1) + "quasiquoteexpand" -> return quasiquote(ast.nth(1)) "quasiquote" -> ast = quasiquote(ast.nth(1)) else -> { val evaluated = eval_ast(ast, env) as ISeq @@ -78,36 +79,42 @@ private fun fn_STAR(ast: MalList, env: Env): MalType { return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) } -private fun is_pair(ast: MalType): Boolean = ast is ISeq && ast.seq().any() - private fun quasiquote(ast: MalType): MalType { - if (!is_pair(ast)) { - val quoted = MalList() - quoted.conj_BANG(MalSymbol("quote")) - quoted.conj_BANG(ast) - return quoted + when (ast) { + is MalList -> { + if (ast.count() == 2 && (ast.first() as? MalSymbol)?.value == "unquote") { + return ast.nth(1) + } else { + return ast.elements.foldRight(MalList(), ::quasiquote_loop) + } + } + is MalVector -> { + val result = MalList() + result.conj_BANG(MalSymbol("vec")) + result.conj_BANG(ast.elements.foldRight(MalList(), ::quasiquote_loop)) + return result + } + is MalSymbol, is MalHashMap -> { + val quoted = MalList() + quoted.conj_BANG(MalSymbol("quote")) + quoted.conj_BANG(ast) + return quoted + } + else -> return ast } +} - val seq = ast as ISeq - var first = seq.first() - - if ((first as? MalSymbol)?.value == "unquote") { - return seq.nth(1) +private fun quasiquote_loop(elt: MalType, acc: MalList): MalList { + val result = MalList() + if (elt is MalList && elt.count() == 2 && (elt.first() as? MalSymbol)?.value == "splice-unquote") { + result.conj_BANG(MalSymbol("concat")) + result.conj_BANG(elt.nth(1)) + } else { + result.conj_BANG(MalSymbol("cons")) + result.conj_BANG(quasiquote(elt)) } - - if (is_pair(first) && ((first as ISeq).first() as? MalSymbol)?.value == "splice-unquote") { - val spliced = MalList() - spliced.conj_BANG(MalSymbol("concat")) - spliced.conj_BANG(first.nth(1)) - spliced.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return spliced - } - - val consed = MalList() - consed.conj_BANG(MalSymbol("cons")) - consed.conj_BANG(quasiquote(ast.first())) - consed.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return consed + result.conj_BANG(acc) + return result } fun print(result: MalType) = pr_str(result, print_readably = true) diff --git a/impls/kotlin/src/mal/step8_macros.kt b/impls/kotlin/src/mal/step8_macros.kt index 59541e15..d3c031fa 100644 --- a/impls/kotlin/src/mal/step8_macros.kt +++ b/impls/kotlin/src/mal/step8_macros.kt @@ -44,6 +44,7 @@ fun eval(_ast: MalType, _env: Env): MalType { } else return NIL } "quote" -> return ast.nth(1) + "quasiquoteexpand" -> return quasiquote(ast.nth(1)) "quasiquote" -> ast = quasiquote(ast.nth(1)) "defmacro!" -> return defmacro(ast, env) "macroexpand" -> return macroexpand(ast.nth(1), env) @@ -82,36 +83,42 @@ private fun fn_STAR(ast: MalList, env: Env): MalType { return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) } -private fun is_pair(ast: MalType): Boolean = ast is ISeq && ast.seq().any() - private fun quasiquote(ast: MalType): MalType { - if (!is_pair(ast)) { - val quoted = MalList() - quoted.conj_BANG(MalSymbol("quote")) - quoted.conj_BANG(ast) - return quoted + when (ast) { + is MalList -> { + if (ast.count() == 2 && (ast.first() as? MalSymbol)?.value == "unquote") { + return ast.nth(1) + } else { + return ast.elements.foldRight(MalList(), ::quasiquote_loop) + } + } + is MalVector -> { + val result = MalList() + result.conj_BANG(MalSymbol("vec")) + result.conj_BANG(ast.elements.foldRight(MalList(), ::quasiquote_loop)) + return result + } + is MalSymbol, is MalHashMap -> { + val quoted = MalList() + quoted.conj_BANG(MalSymbol("quote")) + quoted.conj_BANG(ast) + return quoted + } + else -> return ast } +} - val seq = ast as ISeq - var first = seq.first() - - if ((first as? MalSymbol)?.value == "unquote") { - return seq.nth(1) +private fun quasiquote_loop(elt: MalType, acc: MalList): MalList { + val result = MalList() + if (elt is MalList && elt.count() == 2 && (elt.first() as? MalSymbol)?.value == "splice-unquote") { + result.conj_BANG(MalSymbol("concat")) + result.conj_BANG(elt.nth(1)) + } else { + result.conj_BANG(MalSymbol("cons")) + result.conj_BANG(quasiquote(elt)) } - - if (is_pair(first) && ((first as ISeq).first() as? MalSymbol)?.value == "splice-unquote") { - val spliced = MalList() - spliced.conj_BANG(MalSymbol("concat")) - spliced.conj_BANG(first.nth(1)) - spliced.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return spliced - } - - val consed = MalList() - consed.conj_BANG(MalSymbol("cons")) - consed.conj_BANG(quasiquote(ast.first())) - consed.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return consed + result.conj_BANG(acc) + return result } private fun is_macro_call(ast: MalType, env: Env): Boolean { diff --git a/impls/kotlin/src/mal/step9_try.kt b/impls/kotlin/src/mal/step9_try.kt index 98c4d34c..a65659f8 100644 --- a/impls/kotlin/src/mal/step9_try.kt +++ b/impls/kotlin/src/mal/step9_try.kt @@ -44,6 +44,7 @@ fun eval(_ast: MalType, _env: Env): MalType { } else return NIL } "quote" -> return ast.nth(1) + "quasiquoteexpand" -> return quasiquote(ast.nth(1)) "quasiquote" -> ast = quasiquote(ast.nth(1)) "defmacro!" -> return defmacro(ast, env) "macroexpand" -> return macroexpand(ast.nth(1), env) @@ -83,36 +84,42 @@ private fun fn_STAR(ast: MalList, env: Env): MalType { return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) } -private fun is_pair(ast: MalType): Boolean = ast is ISeq && ast.seq().any() - private fun quasiquote(ast: MalType): MalType { - if (!is_pair(ast)) { - val quoted = MalList() - quoted.conj_BANG(MalSymbol("quote")) - quoted.conj_BANG(ast) - return quoted + when (ast) { + is MalList -> { + if (ast.count() == 2 && (ast.first() as? MalSymbol)?.value == "unquote") { + return ast.nth(1) + } else { + return ast.elements.foldRight(MalList(), ::quasiquote_loop) + } + } + is MalVector -> { + val result = MalList() + result.conj_BANG(MalSymbol("vec")) + result.conj_BANG(ast.elements.foldRight(MalList(), ::quasiquote_loop)) + return result + } + is MalSymbol, is MalHashMap -> { + val quoted = MalList() + quoted.conj_BANG(MalSymbol("quote")) + quoted.conj_BANG(ast) + return quoted + } + else -> return ast } +} - val seq = ast as ISeq - var first = seq.first() - - if ((first as? MalSymbol)?.value == "unquote") { - return seq.nth(1) +private fun quasiquote_loop(elt: MalType, acc: MalList): MalList { + val result = MalList() + if (elt is MalList && elt.count() == 2 && (elt.first() as? MalSymbol)?.value == "splice-unquote") { + result.conj_BANG(MalSymbol("concat")) + result.conj_BANG(elt.nth(1)) + } else { + result.conj_BANG(MalSymbol("cons")) + result.conj_BANG(quasiquote(elt)) } - - if (is_pair(first) && ((first as ISeq).first() as? MalSymbol)?.value == "splice-unquote") { - val spliced = MalList() - spliced.conj_BANG(MalSymbol("concat")) - spliced.conj_BANG(first.nth(1)) - spliced.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return spliced - } - - val consed = MalList() - consed.conj_BANG(MalSymbol("cons")) - consed.conj_BANG(quasiquote(ast.first())) - consed.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return consed + result.conj_BANG(acc) + return result } private fun is_macro_call(ast: MalType, env: Env): Boolean { diff --git a/impls/kotlin/src/mal/stepA_mal.kt b/impls/kotlin/src/mal/stepA_mal.kt index 1b3170d4..b72bfd36 100644 --- a/impls/kotlin/src/mal/stepA_mal.kt +++ b/impls/kotlin/src/mal/stepA_mal.kt @@ -44,6 +44,7 @@ fun eval(_ast: MalType, _env: Env): MalType { } else return NIL } "quote" -> return ast.nth(1) + "quasiquoteexpand" -> return quasiquote(ast.nth(1)) "quasiquote" -> ast = quasiquote(ast.nth(1)) "defmacro!" -> return defmacro(ast, env) "macroexpand" -> return macroexpand(ast.nth(1), env) @@ -83,36 +84,42 @@ private fun fn_STAR(ast: MalList, env: Env): MalType { return MalFnFunction(body, params, env, { s: ISeq -> eval(body, Env(env, params, s.seq())) }) } -private fun is_pair(ast: MalType): Boolean = ast is ISeq && ast.seq().any() - private fun quasiquote(ast: MalType): MalType { - if (!is_pair(ast)) { - val quoted = MalList() - quoted.conj_BANG(MalSymbol("quote")) - quoted.conj_BANG(ast) - return quoted + when (ast) { + is MalList -> { + if (ast.count() == 2 && (ast.first() as? MalSymbol)?.value == "unquote") { + return ast.nth(1) + } else { + return ast.elements.foldRight(MalList(), ::quasiquote_loop) + } + } + is MalVector -> { + val result = MalList() + result.conj_BANG(MalSymbol("vec")) + result.conj_BANG(ast.elements.foldRight(MalList(), ::quasiquote_loop)) + return result + } + is MalSymbol, is MalHashMap -> { + val quoted = MalList() + quoted.conj_BANG(MalSymbol("quote")) + quoted.conj_BANG(ast) + return quoted + } + else -> return ast } +} - val seq = ast as ISeq - var first = seq.first() - - if ((first as? MalSymbol)?.value == "unquote") { - return seq.nth(1) +private fun quasiquote_loop(elt: MalType, acc: MalList): MalList { + val result = MalList() + if (elt is MalList && elt.count() == 2 && (elt.first() as? MalSymbol)?.value == "splice-unquote") { + result.conj_BANG(MalSymbol("concat")) + result.conj_BANG(elt.nth(1)) + } else { + result.conj_BANG(MalSymbol("cons")) + result.conj_BANG(quasiquote(elt)) } - - if (is_pair(first) && ((first as ISeq).first() as? MalSymbol)?.value == "splice-unquote") { - val spliced = MalList() - spliced.conj_BANG(MalSymbol("concat")) - spliced.conj_BANG(first.nth(1)) - spliced.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return spliced - } - - val consed = MalList() - consed.conj_BANG(MalSymbol("cons")) - consed.conj_BANG(quasiquote(ast.first())) - consed.conj_BANG(quasiquote(MalList(seq.seq().drop(1).toCollection(LinkedList())))) - return consed + result.conj_BANG(acc) + return result } private fun is_macro_call(ast: MalType, env: Env): Boolean { diff --git a/impls/livescript/core.ls b/impls/livescript/core.ls index 4199c8ac..6f45e963 100644 --- a/impls/livescript/core.ls +++ b/impls/livescript/core.ls @@ -160,6 +160,12 @@ export ns = do {type: \list, value: params |> map (.value) |> concat} + 'vec': fn (sequence) -> + check-param 'vec', 0, (list-or-vector sequence), + 'list or vector', sequence.type + + {type: \vector, value: sequence.value} + 'nth': fn (list, index) -> check-param 'nth', 0, (list-or-vector list), 'list or vector', list.type diff --git a/impls/livescript/step7_quote.ls b/impls/livescript/step7_quote.ls index 9e474055..9b83bb47 100644 --- a/impls/livescript/step7_quote.ls +++ b/impls/livescript/step7_quote.ls @@ -52,6 +52,7 @@ eval_ast = (env, {type, value}: ast) --> | 'if' => eval_if env, params | 'fn*' => eval_fn env, params | 'quote' => eval_quote env, params + | 'quasiquoteexpand' => eval_quasiquoteexpand params | 'quasiquote' => eval_quasiquote env, params | otherwise => eval_apply env, value else @@ -206,30 +207,51 @@ eval_quote = (env, params) -> params[0] -is-pair = (ast) -> ast.type in [\list \vector] and ast.value.length != 0 - - -eval_quasiquote = (env, params) -> +eval_quasiquoteexpand = (params) -> if params.length != 1 runtime-error "quasiquote expected 1 parameter, got #{params.length}" ast = params[0] - new-ast = if not is-pair ast + quasiquote ast + + +quasiquote = (ast) -> + if ast.type in [\symbol, \map] make-call 'quote', [ast] - else if is-symbol ast.value[0], 'unquote' + else if ast.type == \vector + make-call 'vec', [qq_foldr ast.value] + else if ast.type != \list + ast + else if (ast.value.length == 2) and is-symbol ast.value[0], 'unquote' ast.value[1] - else if is-pair ast.value[0] and \ - is-symbol ast.value[0].value[0], 'splice-unquote' + else + qq_foldr ast.value + + +qq_foldr = (xs) -> + result = make-list [] + for i from xs.length - 1 to 0 by -1 + result := qq_loop xs[i], result + result + + +qq_loop = (elt, acc) -> + if elt.type == \list and \ + elt.value.length == 2 and \ + is-symbol elt.value[0], 'splice-unquote' make-call 'concat', [ - ast.value[0].value[1] - make-call 'quasiquote', [make-list ast.value[1 to]] + elt.value[1] + acc ] else make-call 'cons', [ - make-call 'quasiquote', [ast.value[0]] - make-call 'quasiquote', [make-list ast.value[1 to]] + quasiquote elt + acc ] + +eval_quasiquote = (env, params) -> + new-ast = eval_quasiquoteexpand params defer-tco env, new-ast diff --git a/impls/livescript/step8_macros.ls b/impls/livescript/step8_macros.ls index f92c07b5..337e678c 100644 --- a/impls/livescript/step8_macros.ls +++ b/impls/livescript/step8_macros.ls @@ -56,6 +56,7 @@ eval_ast = (env, ast) --> | 'if' => eval_if env, params | 'fn*' => eval_fn env, params | 'quote' => eval_quote env, params + | 'quasiquoteexpand' => eval_quasiquoteexpand params | 'quasiquote' => eval_quasiquote env, params | 'defmacro!' => eval_defmacro env, params | 'macroexpand' => eval_macroexpand env, params @@ -211,30 +212,51 @@ eval_quote = (env, params) -> params[0] -is-pair = (ast) -> ast.type in [\list \vector] and ast.value.length != 0 - - -eval_quasiquote = (env, params) -> +eval_quasiquoteexpand = (params) -> if params.length != 1 runtime-error "quasiquote expected 1 parameter, got #{params.length}" ast = params[0] - new-ast = if not is-pair ast + quasiquote ast + + +quasiquote = (ast) -> + if ast.type in [\symbol, \map] make-call 'quote', [ast] - else if is-symbol ast.value[0], 'unquote' + else if ast.type == \vector + make-call 'vec', [qq_foldr ast.value] + else if ast.type != \list + ast + else if (ast.value.length == 2) and is-symbol ast.value[0], 'unquote' ast.value[1] - else if is-pair ast.value[0] and \ - is-symbol ast.value[0].value[0], 'splice-unquote' + else + qq_foldr ast.value + + +qq_foldr = (xs) -> + result = make-list [] + for i from xs.length - 1 to 0 by -1 + result := qq_loop xs[i], result + result + + +qq_loop = (elt, acc) -> + if elt.type == \list and \ + elt.value.length == 2 and \ + is-symbol elt.value[0], 'splice-unquote' make-call 'concat', [ - ast.value[0].value[1] - make-call 'quasiquote', [make-list ast.value[1 to]] + elt.value[1] + acc ] else make-call 'cons', [ - make-call 'quasiquote', [ast.value[0]] - make-call 'quasiquote', [make-list ast.value[1 to]] + quasiquote elt + acc ] + +eval_quasiquote = (env, params) -> + new-ast = eval_quasiquoteexpand params defer-tco env, new-ast diff --git a/impls/livescript/step9_try.ls b/impls/livescript/step9_try.ls index 377c3a6b..7945a178 100644 --- a/impls/livescript/step9_try.ls +++ b/impls/livescript/step9_try.ls @@ -56,6 +56,7 @@ eval_ast = (env, ast) --> | 'if' => eval_if env, params | 'fn*' => eval_fn env, params | 'quote' => eval_quote env, params + | 'quasiquoteexpand' => eval_quasiquoteexpand params | 'quasiquote' => eval_quasiquote env, params | 'defmacro!' => eval_defmacro env, params | 'macroexpand' => eval_macroexpand env, params @@ -212,30 +213,51 @@ eval_quote = (env, params) -> params[0] -is-pair = (ast) -> ast.type in [\list \vector] and ast.value.length != 0 - - -eval_quasiquote = (env, params) -> +eval_quasiquoteexpand = (params) -> if params.length != 1 runtime-error "quasiquote expected 1 parameter, got #{params.length}" ast = params[0] - new-ast = if not is-pair ast + quasiquote ast + + +quasiquote = (ast) -> + if ast.type in [\symbol, \map] make-call 'quote', [ast] - else if is-symbol ast.value[0], 'unquote' + else if ast.type == \vector + make-call 'vec', [qq_foldr ast.value] + else if ast.type != \list + ast + else if (ast.value.length == 2) and is-symbol ast.value[0], 'unquote' ast.value[1] - else if is-pair ast.value[0] and \ - is-symbol ast.value[0].value[0], 'splice-unquote' + else + qq_foldr ast.value + + +qq_foldr = (xs) -> + result = make-list [] + for i from xs.length - 1 to 0 by -1 + result := qq_loop xs[i], result + result + + +qq_loop = (elt, acc) -> + if elt.type == \list and \ + elt.value.length == 2 and \ + is-symbol elt.value[0], 'splice-unquote' make-call 'concat', [ - ast.value[0].value[1] - make-call 'quasiquote', [make-list ast.value[1 to]] + elt.value[1] + acc ] else make-call 'cons', [ - make-call 'quasiquote', [ast.value[0]] - make-call 'quasiquote', [make-list ast.value[1 to]] + quasiquote elt + acc ] + +eval_quasiquote = (env, params) -> + new-ast = eval_quasiquoteexpand params defer-tco env, new-ast diff --git a/impls/livescript/stepA_mal.ls b/impls/livescript/stepA_mal.ls index f8808d12..7ee72908 100644 --- a/impls/livescript/stepA_mal.ls +++ b/impls/livescript/stepA_mal.ls @@ -56,6 +56,7 @@ eval_ast = (env, ast) --> | 'if' => eval_if env, params | 'fn*' => eval_fn env, params | 'quote' => eval_quote env, params + | 'quasiquoteexpand' => eval_quasiquoteexpand params | 'quasiquote' => eval_quasiquote env, params | 'defmacro!' => eval_defmacro env, params | 'macroexpand' => eval_macroexpand env, params @@ -212,30 +213,51 @@ eval_quote = (env, params) -> params[0] -is-pair = (ast) -> ast.type in [\list \vector] and ast.value.length != 0 - - -eval_quasiquote = (env, params) -> +eval_quasiquoteexpand = (params) -> if params.length != 1 runtime-error "quasiquote expected 1 parameter, got #{params.length}" ast = params[0] - new-ast = if not is-pair ast + quasiquote ast + + +quasiquote = (ast) -> + if ast.type in [\symbol, \map] make-call 'quote', [ast] - else if is-symbol ast.value[0], 'unquote' + else if ast.type == \vector + make-call 'vec', [qq_foldr ast.value] + else if ast.type != \list + ast + else if (ast.value.length == 2) and is-symbol ast.value[0], 'unquote' ast.value[1] - else if is-pair ast.value[0] and \ - is-symbol ast.value[0].value[0], 'splice-unquote' + else + qq_foldr ast.value + + +qq_foldr = (xs) -> + result = make-list [] + for i from xs.length - 1 to 0 by -1 + result := qq_loop xs[i], result + result + + +qq_loop = (elt, acc) -> + if elt.type == \list and \ + elt.value.length == 2 and \ + is-symbol elt.value[0], 'splice-unquote' make-call 'concat', [ - ast.value[0].value[1] - make-call 'quasiquote', [make-list ast.value[1 to]] + elt.value[1] + acc ] else make-call 'cons', [ - make-call 'quasiquote', [ast.value[0]] - make-call 'quasiquote', [make-list ast.value[1 to]] + quasiquote elt + acc ] + +eval_quasiquote = (env, params) -> + new-ast = eval_quasiquoteexpand params defer-tco env, new-ast diff --git a/impls/logo/core.lg b/impls/logo/core.lg index 6860cdd9..52bd0fbb 100644 --- a/impls/logo/core.lg +++ b/impls/logo/core.lg @@ -233,6 +233,10 @@ to mal_concat [:args] output obj_new "list apply "sentence map [obj_val ?] :args end +to mal_vec :s +output obj_new "vector obj_val :s +end + to mal_nth :a :i if (obj_val :i) >= _count :a [(throw "error [nth: index out of range])] output nth :a obj_val :i @@ -355,7 +359,7 @@ output cond [ end to mal_logo_eval :str -make "res runresult obj_val :str +localmake "res runresult obj_val :str if emptyp :res [output nil_new] output logo_to_mal first :res end @@ -410,6 +414,7 @@ make "core_ns [ [[symbol sequential?] [nativefn mal_sequential_q]] [[symbol cons] [nativefn mal_cons]] [[symbol concat] [nativefn mal_concat]] + [[symbol vec] [nativefn mal_vec]] [[symbol nth] [nativefn mal_nth]] [[symbol first] [nativefn mal_first]] [[symbol rest] [nativefn mal_rest]] diff --git a/impls/logo/step7_quote.lg b/impls/logo/step7_quote.lg index 43bf939f..ff93a887 100644 --- a/impls/logo/step7_quote.lg +++ b/impls/logo/step7_quote.lg @@ -9,22 +9,27 @@ to _read :str output read_str :str end -to pairp :obj -output and sequentialp :obj ((_count :obj) > 0) +to starts_with :ast :sym +if (obj_type :ast) <> "list [output "false] +localmake "xs obj_val :ast +if emptyp :xs [output "false] +localmake "a0 first :xs +output and ((obj_type :a0) = "symbol) ((obj_val :a0) = :sym) end to quasiquote :ast -if not pairp :ast [output (mal_list symbol_new "quote :ast)] -localmake "a0 nth :ast 0 -if symbolnamedp "unquote :a0 [output nth :ast 1] -if pairp :a0 [ - localmake "a00 nth :a0 0 - if symbolnamedp "splice-unquote :a00 [ - localmake "a01 nth :a0 1 - output (mal_list symbol_new "concat :a01 (mal_list symbol_new "quasiquote rest :ast)) - ] -] -output (mal_list symbol_new "cons (mal_list symbol_new "quasiquote :a0) (mal_list symbol_new "quasiquote rest :ast)) +if memberp obj_type :ast [hashmap symbol] [output (mal_list symbol_new "quote :ast)] +if not sequentialp :ast [output :ast] +if starts_with :ast "unquote [output nth :ast 1] +localmake "result mal_list +foreach reverse obj_val :ast [ + ifelse starts_with ? "splice-unquote [ + make "result (mal_list symbol_new "concat nth ? 1 :result) + ] [ + make "result (mal_list symbol_new "cons quasiquote ? :result) + ] ] +if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)] +output :result end to eval_ast :ast :env @@ -67,6 +72,9 @@ forever [ [[[symbol quasiquote]] make "ast quasiquote nth :ast 1 ] ; TCO + [[[symbol quasiquoteexpand]] + output quasiquote nth :ast 1] + [[[symbol do]] localmake "i 1 while [:i < ((_count :ast) - 1)] [ diff --git a/impls/logo/step8_macros.lg b/impls/logo/step8_macros.lg index c08ff659..4f760d7a 100644 --- a/impls/logo/step8_macros.lg +++ b/impls/logo/step8_macros.lg @@ -9,22 +9,27 @@ to _read :str output read_str :str end -to pairp :obj -output and sequentialp :obj ((_count :obj) > 0) +to starts_with :ast :sym +if (obj_type :ast) <> "list [output "false] +localmake "xs obj_val :ast +if emptyp :xs [output "false] +localmake "a0 first :xs +output and ((obj_type :a0) = "symbol) ((obj_val :a0) = :sym) end to quasiquote :ast -if not pairp :ast [output (mal_list symbol_new "quote :ast)] -localmake "a0 nth :ast 0 -if symbolnamedp "unquote :a0 [output nth :ast 1] -if pairp :a0 [ - localmake "a00 nth :a0 0 - if symbolnamedp "splice-unquote :a00 [ - localmake "a01 nth :a0 1 - output (mal_list symbol_new "concat :a01 (mal_list symbol_new "quasiquote rest :ast)) - ] -] -output (mal_list symbol_new "cons (mal_list symbol_new "quasiquote :a0) (mal_list symbol_new "quasiquote rest :ast)) +if memberp obj_type :ast [hashmap symbol] [output (mal_list symbol_new "quote :ast)] +if not sequentialp :ast [output :ast] +if starts_with :ast "unquote [output nth :ast 1] +localmake "result mal_list +foreach reverse obj_val :ast [ + ifelse starts_with ? "splice-unquote [ + make "result (mal_list symbol_new "concat nth ? 1 :result) + ] [ + make "result (mal_list symbol_new "cons quasiquote ? :result) + ] ] +if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)] +output :result end to macrocallp :ast :env @@ -93,6 +98,9 @@ forever [ [[[symbol quasiquote]] make "ast quasiquote nth :ast 1 ] ; TCO + [[[symbol quasiquoteexpand]] + output quasiquote nth :ast 1] + [[[symbol defmacro!]] localmake "a1 nth :ast 1 localmake "a2 nth :ast 2 diff --git a/impls/logo/step9_try.lg b/impls/logo/step9_try.lg index 0dfb8fbe..de7882ed 100644 --- a/impls/logo/step9_try.lg +++ b/impls/logo/step9_try.lg @@ -9,22 +9,27 @@ to _read :str output read_str :str end -to pairp :obj -output and sequentialp :obj ((_count :obj) > 0) +to starts_with :ast :sym +if (obj_type :ast) <> "list [output "false] +localmake "xs obj_val :ast +if emptyp :xs [output "false] +localmake "a0 first :xs +output and ((obj_type :a0) = "symbol) ((obj_val :a0) = :sym) end to quasiquote :ast -if not pairp :ast [output (mal_list symbol_new "quote :ast)] -localmake "a0 nth :ast 0 -if symbolnamedp "unquote :a0 [output nth :ast 1] -if pairp :a0 [ - localmake "a00 nth :a0 0 - if symbolnamedp "splice-unquote :a00 [ - localmake "a01 nth :a0 1 - output (mal_list symbol_new "concat :a01 (mal_list symbol_new "quasiquote rest :ast)) - ] -] -output (mal_list symbol_new "cons (mal_list symbol_new "quasiquote :a0) (mal_list symbol_new "quasiquote rest :ast)) +if memberp obj_type :ast [hashmap symbol] [output (mal_list symbol_new "quote :ast)] +if not sequentialp :ast [output :ast] +if starts_with :ast "unquote [output nth :ast 1] +localmake "result mal_list +foreach reverse obj_val :ast [ + ifelse starts_with ? "splice-unquote [ + make "result (mal_list symbol_new "concat nth ? 1 :result) + ] [ + make "result (mal_list symbol_new "cons quasiquote ? :result) + ] ] +if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)] +output :result end to macrocallp :ast :env @@ -93,6 +98,9 @@ forever [ [[[symbol quasiquote]] make "ast quasiquote nth :ast 1 ] ; TCO + [[[symbol quasiquoteexpand]] + output quasiquote nth :ast 1] + [[[symbol defmacro!]] localmake "a1 nth :ast 1 localmake "a2 nth :ast 2 diff --git a/impls/logo/stepA_mal.lg b/impls/logo/stepA_mal.lg index 4af301c7..c3d13404 100644 --- a/impls/logo/stepA_mal.lg +++ b/impls/logo/stepA_mal.lg @@ -9,22 +9,27 @@ to _read :str output read_str :str end -to pairp :obj -output and sequentialp :obj ((_count :obj) > 0) +to starts_with :ast :sym +if (obj_type :ast) <> "list [output "false] +localmake "xs obj_val :ast +if emptyp :xs [output "false] +localmake "a0 first :xs +output and ((obj_type :a0) = "symbol) ((obj_val :a0) = :sym) end to quasiquote :ast -if not pairp :ast [output (mal_list symbol_new "quote :ast)] -localmake "a0 nth :ast 0 -if symbolnamedp "unquote :a0 [output nth :ast 1] -if pairp :a0 [ - localmake "a00 nth :a0 0 - if symbolnamedp "splice-unquote :a00 [ - localmake "a01 nth :a0 1 - output (mal_list symbol_new "concat :a01 (mal_list symbol_new "quasiquote rest :ast)) - ] -] -output (mal_list symbol_new "cons (mal_list symbol_new "quasiquote :a0) (mal_list symbol_new "quasiquote rest :ast)) +if memberp obj_type :ast [hashmap symbol] [output (mal_list symbol_new "quote :ast)] +if not sequentialp :ast [output :ast] +if starts_with :ast "unquote [output nth :ast 1] +localmake "result mal_list +foreach reverse obj_val :ast [ + ifelse starts_with ? "splice-unquote [ + make "result (mal_list symbol_new "concat nth ? 1 :result) + ] [ + make "result (mal_list symbol_new "cons quasiquote ? :result) + ] ] +if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)] +output :result end to macrocallp :ast :env @@ -93,6 +98,9 @@ forever [ [[[symbol quasiquote]] make "ast quasiquote nth :ast 1 ] ; TCO + [[[symbol quasiquoteexpand]] + output quasiquote nth :ast 1] + [[[symbol defmacro!]] localmake "a1 nth :ast 1 localmake "a2 nth :ast 2 diff --git a/impls/logo/types.lg b/impls/logo/types.lg index e7bffd16..dd5fcd1a 100644 --- a/impls/logo/types.lg +++ b/impls/logo/types.lg @@ -131,7 +131,7 @@ foreach obj_val :seq [ end to sequentialp :obj -output or ((obj_type :obj) = "list) ((obj_type :obj) = "vector) +output memberp obj_type :obj [list vector] end to equal_sequential_q :a :b @@ -169,7 +169,3 @@ output cond [ [else "false] ] end - -to symbolnamedp :name :obj -output and ((obj_type :obj) = "symbol) ((obj_val :obj) = :name) -end diff --git a/impls/lua/core.lua b/impls/lua/core.lua index 1d8a07fc..631479da 100644 --- a/impls/lua/core.lua +++ b/impls/lua/core.lua @@ -106,6 +106,10 @@ function concat(...) return List:new(new_lst) end +function vec(a) + return types.Vector:new(a) +end + function nth(seq, idx) if idx+1 <= #seq then return seq[idx+1] @@ -295,6 +299,7 @@ M.ns = { ['sequential?'] = types._sequential_Q, cons = cons, concat = concat, + vec = vec, nth = nth, first = first, rest = rest, diff --git a/impls/lua/step7_quote.lua b/impls/lua/step7_quote.lua index 30d5cb7a..c40c40c3 100755 --- a/impls/lua/step7_quote.lua +++ b/impls/lua/step7_quote.lua @@ -17,25 +17,36 @@ function READ(str) end -- eval -function is_pair(x) - return types._sequential_Q(x) and #x > 0 +function starts_with(ast, sym) + return 0 < #ast and types._symbol_Q(ast[1]) and ast[1].val == sym +end + +function quasiquote_loop(ast) + local acc = types.List:new({}) + for i = #ast,1,-1 do + local elt = ast[i] + if types._list_Q(elt) and starts_with(elt, "splice-unquote") then + acc = types.List:new({types.Symbol:new("concat"), elt[2], acc}) + else + acc = types.List:new({types.Symbol:new("cons"), quasiquote(elt), acc}) + end + end + return acc end function quasiquote(ast) - if not is_pair(ast) then + if types._list_Q(ast) then + if starts_with(ast, "unquote") then + return ast[2] + else + return quasiquote_loop(ast) + end + elseif types._vector_Q(ast) then + return types.List:new({types.Symbol:new("vec"), quasiquote_loop(ast)}) + elseif types._symbol_Q(ast) or types._hash_map_Q(ast) then return types.List:new({types.Symbol:new("quote"), ast}) - elseif types._symbol_Q(ast[1]) and ast[1].val == 'unquote' then - return ast[2] - elseif is_pair(ast[1]) and - types._symbol_Q(ast[1][1]) and - ast[1][1].val == 'splice-unquote' then - return types.List:new({types.Symbol:new("concat"), - ast[1][2], - quasiquote(ast:slice(2))}) else - return types.List:new({types.Symbol:new("cons"), - quasiquote(ast[1]), - quasiquote(ast:slice(2))}) + return ast end end @@ -76,6 +87,8 @@ function EVAL(ast, env) ast = a2 -- TCO elseif 'quote' == a0sym then return a1 + elseif 'quasiquoteexpand' == a0sym then + return quasiquote(a1) elseif 'quasiquote' == a0sym then ast = quasiquote(a1) -- TCO elseif 'do' == a0sym then diff --git a/impls/lua/step8_macros.lua b/impls/lua/step8_macros.lua index 4265658a..06f675de 100755 --- a/impls/lua/step8_macros.lua +++ b/impls/lua/step8_macros.lua @@ -17,25 +17,36 @@ function READ(str) end -- eval -function is_pair(x) - return types._sequential_Q(x) and #x > 0 +function starts_with(ast, sym) + return 0 < #ast and types._symbol_Q(ast[1]) and ast[1].val == sym +end + +function quasiquote_loop(ast) + local acc = types.List:new({}) + for i = #ast,1,-1 do + local elt = ast[i] + if types._list_Q(elt) and starts_with(elt, "splice-unquote") then + acc = types.List:new({types.Symbol:new("concat"), elt[2], acc}) + else + acc = types.List:new({types.Symbol:new("cons"), quasiquote(elt), acc}) + end + end + return acc end function quasiquote(ast) - if not is_pair(ast) then + if types._list_Q(ast) then + if starts_with(ast, "unquote") then + return ast[2] + else + return quasiquote_loop(ast) + end + elseif types._vector_Q(ast) then + return types.List:new({types.Symbol:new("vec"), quasiquote_loop(ast)}) + elseif types._symbol_Q(ast) or types._hash_map_Q(ast) then return types.List:new({types.Symbol:new("quote"), ast}) - elseif types._symbol_Q(ast[1]) and ast[1].val == 'unquote' then - return ast[2] - elseif is_pair(ast[1]) and - types._symbol_Q(ast[1][1]) and - ast[1][1].val == 'splice-unquote' then - return types.List:new({types.Symbol:new("concat"), - ast[1][2], - quasiquote(ast:slice(2))}) else - return types.List:new({types.Symbol:new("cons"), - quasiquote(ast[1]), - quasiquote(ast:slice(2))}) + return ast end end @@ -97,6 +108,8 @@ function EVAL(ast, env) ast = a2 -- TCO elseif 'quote' == a0sym then return a1 + elseif 'quasiquoteexpand' == a0sym then + return quasiquote(a1) elseif 'quasiquote' == a0sym then ast = quasiquote(a1) -- TCO elseif 'defmacro!' == a0sym then diff --git a/impls/lua/step9_try.lua b/impls/lua/step9_try.lua index a1e55c07..31635da5 100755 --- a/impls/lua/step9_try.lua +++ b/impls/lua/step9_try.lua @@ -17,25 +17,36 @@ function READ(str) end -- eval -function is_pair(x) - return types._sequential_Q(x) and #x > 0 +function starts_with(ast, sym) + return 0 < #ast and types._symbol_Q(ast[1]) and ast[1].val == sym +end + +function quasiquote_loop(ast) + local acc = types.List:new({}) + for i = #ast,1,-1 do + local elt = ast[i] + if types._list_Q(elt) and starts_with(elt, "splice-unquote") then + acc = types.List:new({types.Symbol:new("concat"), elt[2], acc}) + else + acc = types.List:new({types.Symbol:new("cons"), quasiquote(elt), acc}) + end + end + return acc end function quasiquote(ast) - if not is_pair(ast) then + if types._list_Q(ast) then + if starts_with(ast, "unquote") then + return ast[2] + else + return quasiquote_loop(ast) + end + elseif types._vector_Q(ast) then + return types.List:new({types.Symbol:new("vec"), quasiquote_loop(ast)}) + elseif types._symbol_Q(ast) or types._hash_map_Q(ast) then return types.List:new({types.Symbol:new("quote"), ast}) - elseif types._symbol_Q(ast[1]) and ast[1].val == 'unquote' then - return ast[2] - elseif is_pair(ast[1]) and - types._symbol_Q(ast[1][1]) and - ast[1][1].val == 'splice-unquote' then - return types.List:new({types.Symbol:new("concat"), - ast[1][2], - quasiquote(ast:slice(2))}) else - return types.List:new({types.Symbol:new("cons"), - quasiquote(ast[1]), - quasiquote(ast:slice(2))}) + return ast end end @@ -97,6 +108,8 @@ function EVAL(ast, env) ast = a2 -- TCO elseif 'quote' == a0sym then return a1 + elseif 'quasiquoteexpand' == a0sym then + return quasiquote(a1) elseif 'quasiquote' == a0sym then ast = quasiquote(a1) -- TCO elseif 'defmacro!' == a0sym then diff --git a/impls/lua/stepA_mal.lua b/impls/lua/stepA_mal.lua index 302e359b..2d4cf23c 100755 --- a/impls/lua/stepA_mal.lua +++ b/impls/lua/stepA_mal.lua @@ -18,25 +18,36 @@ function READ(str) end -- eval -function is_pair(x) - return types._sequential_Q(x) and #x > 0 +function starts_with(ast, sym) + return 0 < #ast and types._symbol_Q(ast[1]) and ast[1].val == sym +end + +function quasiquote_loop(ast) + local acc = types.List:new({}) + for i = #ast,1,-1 do + local elt = ast[i] + if types._list_Q(elt) and starts_with(elt, "splice-unquote") then + acc = types.List:new({types.Symbol:new("concat"), elt[2], acc}) + else + acc = types.List:new({types.Symbol:new("cons"), quasiquote(elt), acc}) + end + end + return acc end function quasiquote(ast) - if not is_pair(ast) then + if types._list_Q(ast) then + if starts_with(ast, "unquote") then + return ast[2] + else + return quasiquote_loop(ast) + end + elseif types._vector_Q(ast) then + return types.List:new({types.Symbol:new("vec"), quasiquote_loop(ast)}) + elseif types._symbol_Q(ast) or types._hash_map_Q(ast) then return types.List:new({types.Symbol:new("quote"), ast}) - elseif types._symbol_Q(ast[1]) and ast[1].val == 'unquote' then - return ast[2] - elseif is_pair(ast[1]) and - types._symbol_Q(ast[1][1]) and - ast[1][1].val == 'splice-unquote' then - return types.List:new({types.Symbol:new("concat"), - ast[1][2], - quasiquote(ast:slice(2))}) else - return types.List:new({types.Symbol:new("cons"), - quasiquote(ast[1]), - quasiquote(ast:slice(2))}) + return ast end end @@ -98,6 +109,8 @@ function EVAL(ast, env) ast = a2 -- TCO elseif 'quote' == a0sym then return a1 + elseif 'quasiquoteexpand' == a0sym then + return quasiquote(a1) elseif 'quasiquote' == a0sym then ast = quasiquote(a1) -- TCO elseif 'defmacro!' == a0sym then diff --git a/impls/make/core.mk b/impls/make/core.mk index 4e6da5b0..1823cb2e 100644 --- a/impls/make/core.mk +++ b/impls/make/core.mk @@ -87,6 +87,8 @@ list? = $(if $(call _list?,$(1)),$(__true),$(__false)) # Vector functions vector? = $(if $(call _vector?,$(1)),$(__true),$(__false)) +vec = $(if $(_list?),$(call _vector,$($1_value)),$(if $(_vector?),$1,$(call _error,vec: called on non-sequence))) + # Hash map (associative array) functions hash_map? = $(if $(call _hash_map?,$(1)),$(__true),$(__false)) @@ -140,7 +142,7 @@ sfirst = $(word 1,$($(1)_value)) slast = $(word $(words $($(1)_value)),$($(1)_value)) -empty? = $(if $(call _EQ,0,$(if $(call _hash_map?,$(1)),$($(1)_size),$(words $($(1)_value)))),$(__true),$(__false)) +empty? = $(if $(_empty?),$(__true),$(__false)) count = $(call _number,$(call _count,$(1))) @@ -278,6 +280,7 @@ core_ns = type obj_type \ sequential? sequential? \ cons cons \ concat concat \ + vec vec \ nth nth \ first sfirst \ rest srest \ diff --git a/impls/make/step7_quote.mk b/impls/make/step7_quote.mk index ba961832..92c0dcb7 100644 --- a/impls/make/step7_quote.mk +++ b/impls/make/step7_quote.mk @@ -18,18 +18,24 @@ $(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE," endef # EVAL: evaluate the parameter -IS_PAIR = $(if $(call _sequential?,$(1)),$(if $(call _EQ,0,$(call _count,$(1))),,true),) -define QUASIQUOTE -$(strip \ - $(if $(call _NOT,$(call IS_PAIR,$(1))),\ - $(call _list,$(call _symbol,quote) $(1)),\ - $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ - $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ - $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) -endef +# 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) + +# 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 \ @@ -78,6 +84,8 @@ $(if $(__ERROR),,\ $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ $(if $(call _EQ,quote,$($(a0)_value)),\ $(call _nth,$(1),1),\ + $(if $(call _EQ,quasiquoteexpand,$($(a0)_value)),\ + $(call QUASIQUOTE,$(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)),\ @@ -97,7 +105,7 @@ $(if $(__ERROR),,\ $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ $(foreach f,$(call sfirst,$(el)),\ $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args)))))))))))))) + $(call apply,$(f),$(args))))))))))))))) endef define EVAL diff --git a/impls/make/step8_macros.mk b/impls/make/step8_macros.mk index ed0cd6fb..10d4046a 100644 --- a/impls/make/step8_macros.mk +++ b/impls/make/step8_macros.mk @@ -18,19 +18,24 @@ $(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE," endef # EVAL: evaluate the parameter -IS_PAIR = $(if $(call _sequential?,$(1)),$(if $(call _EQ,0,$(call _count,$(1))),,true),) -define QUASIQUOTE -$(strip \ - $(if $(call _NOT,$(call IS_PAIR,$(1))),\ - $(call _list,$(call _symbol,quote) $(1)),\ - $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ - $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ - $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) -endef +# 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) +# 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 IS_MACRO_CALL $(if $(call _list?,$(1)),$(if $(call ENV_FIND,$(2),$($(call _nth,$(1),0)_value)),$(_macro_$(call ENV_GET,$(2),$($(call _nth,$(1),0)_value))),),) endef @@ -90,6 +95,8 @@ $(if $(__ERROR),,\ $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ $(if $(call _EQ,quote,$($(a0)_value)),\ $(call _nth,$(1),1),\ + $(if $(call _EQ,quasiquoteexpand,$($(a0)_value)),\ + $(call QUASIQUOTE,$(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)),\ @@ -117,7 +124,7 @@ $(if $(__ERROR),,\ $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ $(foreach f,$(call sfirst,$(el)),\ $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args)))))))))))))))) + $(call apply,$(f),$(args))))))))))))))))) endef define EVAL diff --git a/impls/make/step9_try.mk b/impls/make/step9_try.mk index a179d8c4..fd49e82d 100644 --- a/impls/make/step9_try.mk +++ b/impls/make/step9_try.mk @@ -18,19 +18,24 @@ $(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE," endef # EVAL: evaluate the parameter -IS_PAIR = $(if $(call _sequential?,$(1)),$(if $(call _EQ,0,$(call _count,$(1))),,true),) -define QUASIQUOTE -$(strip \ - $(if $(call _NOT,$(call IS_PAIR,$(1))),\ - $(call _list,$(call _symbol,quote) $(1)),\ - $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ - $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ - $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) -endef +# 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) +# 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 IS_MACRO_CALL $(if $(call _list?,$(1)),$(if $(call ENV_FIND,$(2),$($(call _nth,$(1),0)_value)),$(_macro_$(call ENV_GET,$(2),$($(call _nth,$(1),0)_value))),),) endef @@ -90,6 +95,8 @@ $(if $(__ERROR),,\ $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ $(if $(call _EQ,quote,$($(a0)_value)),\ $(call _nth,$(1),1),\ + $(if $(call _EQ,quasiquoteexpand,$($(a0)_value)),\ + $(call QUASIQUOTE,$(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)),\ @@ -132,7 +139,7 @@ $(if $(__ERROR),,\ $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ $(foreach f,$(call sfirst,$(el)),\ $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args))))))))))))))))) + $(call apply,$(f),$(args)))))))))))))))))) endef define EVAL diff --git a/impls/make/stepA_mal.mk b/impls/make/stepA_mal.mk index c3bbd1c3..fb5c4648 100644 --- a/impls/make/stepA_mal.mk +++ b/impls/make/stepA_mal.mk @@ -18,19 +18,24 @@ $(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE," endef # EVAL: evaluate the parameter -IS_PAIR = $(if $(call _sequential?,$(1)),$(if $(call _EQ,0,$(call _count,$(1))),,true),) -define QUASIQUOTE -$(strip \ - $(if $(call _NOT,$(call IS_PAIR,$(1))),\ - $(call _list,$(call _symbol,quote) $(1)),\ - $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ - $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ - $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) -endef +# 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) +# 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 IS_MACRO_CALL $(if $(call _list?,$(1)),$(if $(call ENV_FIND,$(2),$($(call _nth,$(1),0)_value)),$(_macro_$(call ENV_GET,$(2),$($(call _nth,$(1),0)_value))),),) endef @@ -90,6 +95,8 @@ $(if $(__ERROR),,\ $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ $(if $(call _EQ,quote,$($(a0)_value)),\ $(call _nth,$(1),1),\ + $(if $(call _EQ,quasiquoteexpand,$($(a0)_value)),\ + $(call QUASIQUOTE,$(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)),\ @@ -136,7 +143,7 @@ $(if $(__ERROR),,\ $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ $(foreach f,$(call sfirst,$(el)),\ $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args)))))))))))))))))) + $(call apply,$(f),$(args))))))))))))))))))) endef define EVAL diff --git a/impls/make/types.mk b/impls/make/types.mk index ba2aeb52..a5a055a5 100644 --- a/impls/make/types.mk +++ b/impls/make/types.mk @@ -237,6 +237,8 @@ _count = $(strip \ $($(1)_size),\ $(words $($(1)_value)))) +_empty? = $(call _EQ,0,$(_count)) + # Creates a new vector/list of the everything after but the first # element srest = $(word 1,$(foreach new_list,$(call _list),\ diff --git a/impls/mal/core.mal b/impls/mal/core.mal index b7200bff..11af4719 100644 --- a/impls/mal/core.mal +++ b/impls/mal/core.mal @@ -51,6 +51,7 @@ ['sequential? sequential?] ['cons cons] ['concat concat] + ['vec vec] ['nth nth] ['first first] ['rest rest] diff --git a/impls/mal/step2_eval.mal b/impls/mal/step2_eval.mal index 4df08ce1..430020e7 100644 --- a/impls/mal/step2_eval.mal +++ b/impls/mal/step2_eval.mal @@ -11,7 +11,7 @@ (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) + (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) (map? ast) (apply hash-map (apply concat diff --git a/impls/mal/step3_env.mal b/impls/mal/step3_env.mal index b21dfa21..fda2dbec 100644 --- a/impls/mal/step3_env.mal +++ b/impls/mal/step3_env.mal @@ -12,7 +12,7 @@ (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) + (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) (map? ast) (apply hash-map (apply concat diff --git a/impls/mal/step4_if_fn_do.mal b/impls/mal/step4_if_fn_do.mal index 40c20391..a07e6dd7 100644 --- a/impls/mal/step4_if_fn_do.mal +++ b/impls/mal/step4_if_fn_do.mal @@ -13,7 +13,7 @@ (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) + (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) (map? ast) (apply hash-map (apply concat diff --git a/impls/mal/step6_file.mal b/impls/mal/step6_file.mal index af04175b..bb97cb1a 100644 --- a/impls/mal/step6_file.mal +++ b/impls/mal/step6_file.mal @@ -13,7 +13,7 @@ (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) + (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) (map? ast) (apply hash-map (apply concat diff --git a/impls/mal/step7_quote.mal b/impls/mal/step7_quote.mal index faabb476..c0f0546e 100644 --- a/impls/mal/step7_quote.mal +++ b/impls/mal/step7_quote.mal @@ -6,23 +6,23 @@ ;; eval -(def! is-pair (fn* [x] - (if (sequential? x) - (not (empty? x))))) +(def! qq-loop (fn* [elt acc] + (if (if (list? elt) (= (first elt) 'splice-unquote)) ; 2nd 'if' means 'and' + (list 'concat (nth elt 1) acc) + (list 'cons (QUASIQUOTE elt) acc)))) +(def! qq-foldr (fn* [xs] + (if (empty? xs) + (list) + (qq-loop (first xs) (qq-foldr (rest xs)))))) (def! QUASIQUOTE (fn* [ast] - (if (not (is-pair ast)) - (list 'quote ast) - (let* [a0 (first ast)] - (cond - (= 'unquote a0) - (nth ast 1) - - (if (is-pair a0) (= 'splice-unquote (first a0))) ; `if` means `and` - (list 'concat (nth a0 1) (QUASIQUOTE (rest ast))) - - "else" - (list 'cons (QUASIQUOTE a0) (QUASIQUOTE (rest ast)))))))) + (cond + (vector? ast) (list 'vec (qq-foldr ast)) + (map? ast) (list 'quote ast) + (symbol? ast) (list 'quote ast) + (not (list? ast)) ast + (= (first ast) 'unquote) (nth ast 1) + "else" (qq-foldr ast)))) (def! eval-ast (fn* [ast env] ;; (do (prn "eval-ast" ast "/" (keys env)) ) @@ -31,7 +31,7 @@ (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) + (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) (map? ast) (apply hash-map (apply concat @@ -67,6 +67,9 @@ (= 'quote a0) (nth ast 1) + (= 'quasiquoteexpand a0) + (QUASIQUOTE (nth ast 1)) + (= 'quasiquote a0) (EVAL (QUASIQUOTE (nth ast 1)) env) diff --git a/impls/mal/step8_macros.mal b/impls/mal/step8_macros.mal index 928a39c9..7d5e1806 100644 --- a/impls/mal/step8_macros.mal +++ b/impls/mal/step8_macros.mal @@ -6,23 +6,23 @@ ;; eval -(def! is-pair (fn* [x] - (if (sequential? x) - (not (empty? x))))) +(def! qq-loop (fn* [elt acc] + (if (if (list? elt) (= (first elt) 'splice-unquote)) ; 2nd 'if' means 'and' + (list 'concat (nth elt 1) acc) + (list 'cons (QUASIQUOTE elt) acc)))) +(def! qq-foldr (fn* [xs] + (if (empty? xs) + (list) + (qq-loop (first xs) (qq-foldr (rest xs)))))) (def! QUASIQUOTE (fn* [ast] - (if (not (is-pair ast)) - (list 'quote ast) - (let* [a0 (first ast)] - (cond - (= 'unquote a0) - (nth ast 1) - - (if (is-pair a0) (= 'splice-unquote (first a0))) ; `if` means `and` - (list 'concat (nth a0 1) (QUASIQUOTE (rest ast))) - - "else" - (list 'cons (QUASIQUOTE a0) (QUASIQUOTE (rest ast)))))))) + (cond + (vector? ast) (list 'vec (qq-foldr ast)) + (map? ast) (list 'quote ast) + (symbol? ast) (list 'quote ast) + (not (list? ast)) ast + (= (first ast) 'unquote) (nth ast 1) + "else" (qq-foldr ast)))) (def! MACROEXPAND (fn* [ast env] (let* [a0 (if (list? ast) (first ast)) @@ -39,7 +39,7 @@ (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) + (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) (map? ast) (apply hash-map (apply concat @@ -76,6 +76,9 @@ (= 'quote a0) (nth ast 1) + (= 'quasiquoteexpand a0) + (QUASIQUOTE (nth ast 1)) + (= 'quasiquote a0) (EVAL (QUASIQUOTE (nth ast 1)) env) diff --git a/impls/mal/step9_try.mal b/impls/mal/step9_try.mal index 3f42d728..3ca405bd 100644 --- a/impls/mal/step9_try.mal +++ b/impls/mal/step9_try.mal @@ -6,23 +6,23 @@ ;; eval -(def! is-pair (fn* [x] - (if (sequential? x) - (not (empty? x))))) +(def! qq-loop (fn* [elt acc] + (if (if (list? elt) (= (first elt) 'splice-unquote)) ; 2nd 'if' means 'and' + (list 'concat (nth elt 1) acc) + (list 'cons (QUASIQUOTE elt) acc)))) +(def! qq-foldr (fn* [xs] + (if (empty? xs) + (list) + (qq-loop (first xs) (qq-foldr (rest xs)))))) (def! QUASIQUOTE (fn* [ast] - (if (not (is-pair ast)) - (list 'quote ast) - (let* [a0 (first ast)] - (cond - (= 'unquote a0) - (nth ast 1) - - (if (is-pair a0) (= 'splice-unquote (first a0))) ; `if` means `and` - (list 'concat (nth a0 1) (QUASIQUOTE (rest ast))) - - "else" - (list 'cons (QUASIQUOTE a0) (QUASIQUOTE (rest ast)))))))) + (cond + (vector? ast) (list 'vec (qq-foldr ast)) + (map? ast) (list 'quote ast) + (symbol? ast) (list 'quote ast) + (not (list? ast)) ast + (= (first ast) 'unquote) (nth ast 1) + "else" (qq-foldr ast)))) (def! MACROEXPAND (fn* [ast env] (let* [a0 (if (list? ast) (first ast)) @@ -39,7 +39,7 @@ (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) + (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) (map? ast) (apply hash-map (apply concat @@ -76,6 +76,9 @@ (= 'quote a0) (nth ast 1) + (= 'quasiquoteexpand a0) + (QUASIQUOTE (nth ast 1)) + (= 'quasiquote a0) (EVAL (QUASIQUOTE (nth ast 1)) env) diff --git a/impls/mal/stepA_mal.mal b/impls/mal/stepA_mal.mal index 9df5b85c..57443922 100644 --- a/impls/mal/stepA_mal.mal +++ b/impls/mal/stepA_mal.mal @@ -6,23 +6,23 @@ ;; eval -(def! is-pair (fn* [x] - (if (sequential? x) - (not (empty? x))))) +(def! qq-loop (fn* [elt acc] + (if (if (list? elt) (= (first elt) 'splice-unquote)) ; 2nd 'if' means 'and' + (list 'concat (nth elt 1) acc) + (list 'cons (QUASIQUOTE elt) acc)))) +(def! qq-foldr (fn* [xs] + (if (empty? xs) + (list) + (qq-loop (first xs) (qq-foldr (rest xs)))))) (def! QUASIQUOTE (fn* [ast] - (if (not (is-pair ast)) - (list 'quote ast) - (let* [a0 (first ast)] - (cond - (= 'unquote a0) - (nth ast 1) - - (if (is-pair a0) (= 'splice-unquote (first a0))) ; `if` means `and` - (list 'concat (nth a0 1) (QUASIQUOTE (rest ast))) - - "else" - (list 'cons (QUASIQUOTE a0) (QUASIQUOTE (rest ast)))))))) + (cond + (vector? ast) (list 'vec (qq-foldr ast)) + (map? ast) (list 'quote ast) + (symbol? ast) (list 'quote ast) + (not (list? ast)) ast + (= (first ast) 'unquote) (nth ast 1) + "else" (qq-foldr ast)))) (def! MACROEXPAND (fn* [ast env] (let* [a0 (if (list? ast) (first ast)) @@ -39,7 +39,7 @@ (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - (vector? ast) (apply vector (map (fn* [exp] (EVAL exp env)) ast)) + (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) (map? ast) (apply hash-map (apply concat @@ -76,6 +76,9 @@ (= 'quote a0) (nth ast 1) + (= 'quasiquoteexpand a0) + (QUASIQUOTE (nth ast 1)) + (= 'quasiquote a0) (EVAL (QUASIQUOTE (nth ast 1)) env) diff --git a/impls/matlab/core.m b/impls/matlab/core.m index 2b2d1047..44c0ba4e 100644 --- a/impls/matlab/core.m +++ b/impls/matlab/core.m @@ -278,6 +278,7 @@ classdef core n('sequential?') = @(a) type_utils.sequential_Q(a); n('cons') = @(a,b) core.cons(a,b); n('concat') = @(varargin) core.concat(varargin{:}); + n('vec') = @(a) types.Vector(a.data{:}); n('nth') = @(a,b) core.nth(a,b); n('first') = @(a) core.first(a); n('rest') = @(a) core.rest(a); diff --git a/impls/matlab/step7_quote.m b/impls/matlab/step7_quote.m index 63c7a453..9c90b1a9 100644 --- a/impls/matlab/step7_quote.m +++ b/impls/matlab/step7_quote.m @@ -6,26 +6,40 @@ function ret = READ(str) end % eval -function ret = is_pair(ast) - ret = type_utils.sequential_Q(ast) && length(ast) > 0; +function ret = starts_with(ast, sym) + ret = length(ast); + if ret + first = ast.get(1); + ret = isa(first,'types.Symbol') && strcmp(first.name, sym); + end +end + +function ret = quasiquote_loop(ast) + ret = types.List(); + for i=length(ast):-1:1 + elt = ast.get(i) + if isa(elt, 'types.List') && starts_with(elt, 'splice-unquote') + ret = types.List(types.Symbol('concat'), elt.get(2), ret); + else + ret = types.List(types.Symbol('cons'), quasiquote(elt), ret); + end + end end function ret = quasiquote(ast) - if ~is_pair(ast) + switch class(ast) + case 'types.List' + if starts_with(ast, 'unquote') + ret = ast.get(2); + else + ret = quasiquote_loop(ast); + end + case 'types.Vector' + ret = types.List(types.Symbol('vec'), quasiquote_loop(ast)); + case {'types.Symbol', 'types.HashMap'} ret = types.List(types.Symbol('quote'), ast); - elseif isa(ast.get(1),'types.Symbol') && ... - strcmp(ast.get(1).name, 'unquote') - ret = ast.get(2); - elseif is_pair(ast.get(1)) && ... - isa(ast.get(1).get(1),'types.Symbol') && ... - strcmp(ast.get(1).get(1).name, 'splice-unquote') - ret = types.List(types.Symbol('concat'), ... - ast.get(1).get(2), ... - quasiquote(ast.slice(2))); - else - ret = types.List(types.Symbol('cons'), ... - quasiquote(ast.get(1)), ... - quasiquote(ast.slice(2))); + otherwise + ret = ast; end end @@ -87,6 +101,9 @@ function ret = EVAL(ast, env) case 'quote' ret = ast.get(2); return; + case 'quasiquoteexpand' + ret = quasiquote(ast.get(2)); + return; case 'quasiquote' ast = quasiquote(ast.get(2)); % TCO case 'do' diff --git a/impls/matlab/step8_macros.m b/impls/matlab/step8_macros.m index d16519e0..9cec30b4 100644 --- a/impls/matlab/step8_macros.m +++ b/impls/matlab/step8_macros.m @@ -6,26 +6,40 @@ function ret = READ(str) end % eval -function ret = is_pair(ast) - ret = type_utils.sequential_Q(ast) && length(ast) > 0; +function ret = starts_with(ast, sym) + ret = length(ast); + if ret + first = ast.get(1); + ret = isa(first,'types.Symbol') && strcmp(first.name, sym); + end +end + +function ret = quasiquote_loop(ast) + ret = types.List(); + for i=length(ast):-1:1 + elt = ast.get(i) + if isa(elt, 'types.List') && starts_with(elt, 'splice-unquote') + ret = types.List(types.Symbol('concat'), elt.get(2), ret); + else + ret = types.List(types.Symbol('cons'), quasiquote(elt), ret); + end + end end function ret = quasiquote(ast) - if ~is_pair(ast) + switch class(ast) + case 'types.List' + if starts_with(ast, 'unquote') + ret = ast.get(2); + else + ret = quasiquote_loop(ast); + end + case 'types.Vector' + ret = types.List(types.Symbol('vec'), quasiquote_loop(ast)); + case {'types.Symbol', 'types.HashMap'} ret = types.List(types.Symbol('quote'), ast); - elseif isa(ast.get(1),'types.Symbol') && ... - strcmp(ast.get(1).name, 'unquote') - ret = ast.get(2); - elseif is_pair(ast.get(1)) && ... - isa(ast.get(1).get(1),'types.Symbol') && ... - strcmp(ast.get(1).get(1).name, 'splice-unquote') - ret = types.List(types.Symbol('concat'), ... - ast.get(1).get(2), ... - quasiquote(ast.slice(2))); - else - ret = types.List(types.Symbol('cons'), ... - quasiquote(ast.get(1)), ... - quasiquote(ast.slice(2))); + otherwise + ret = ast; end end @@ -112,6 +126,9 @@ function ret = EVAL(ast, env) case 'quote' ret = ast.get(2); return; + case 'quasiquoteexpand' + ret = quasiquote(ast.get(2)); + return; case 'quasiquote' ast = quasiquote(ast.get(2)); % TCO case 'defmacro!' diff --git a/impls/matlab/step9_try.m b/impls/matlab/step9_try.m index a640ec97..4f9d960e 100644 --- a/impls/matlab/step9_try.m +++ b/impls/matlab/step9_try.m @@ -6,26 +6,40 @@ function ret = READ(str) end % eval -function ret = is_pair(ast) - ret = type_utils.sequential_Q(ast) && length(ast) > 0; +function ret = starts_with(ast, sym) + ret = length(ast); + if ret + first = ast.get(1); + ret = isa(first,'types.Symbol') && strcmp(first.name, sym); + end +end + +function ret = quasiquote_loop(ast) + ret = types.List(); + for i=length(ast):-1:1 + elt = ast.get(i) + if isa(elt, 'types.List') && starts_with(elt, 'splice-unquote') + ret = types.List(types.Symbol('concat'), elt.get(2), ret); + else + ret = types.List(types.Symbol('cons'), quasiquote(elt), ret); + end + end end function ret = quasiquote(ast) - if ~is_pair(ast) + switch class(ast) + case 'types.List' + if starts_with(ast, 'unquote') + ret = ast.get(2); + else + ret = quasiquote_loop(ast); + end + case 'types.Vector' + ret = types.List(types.Symbol('vec'), quasiquote_loop(ast)); + case {'types.Symbol', 'types.HashMap'} ret = types.List(types.Symbol('quote'), ast); - elseif isa(ast.get(1),'types.Symbol') && ... - strcmp(ast.get(1).name, 'unquote') - ret = ast.get(2); - elseif is_pair(ast.get(1)) && ... - isa(ast.get(1).get(1),'types.Symbol') && ... - strcmp(ast.get(1).get(1).name, 'splice-unquote') - ret = types.List(types.Symbol('concat'), ... - ast.get(1).get(2), ... - quasiquote(ast.slice(2))); - else - ret = types.List(types.Symbol('cons'), ... - quasiquote(ast.get(1)), ... - quasiquote(ast.slice(2))); + otherwise + ret = ast; end end @@ -112,6 +126,9 @@ function ret = EVAL(ast, env) case 'quote' ret = ast.get(2); return; + case 'quasiquoteexpand' + ret = quasiquote(ast.get(2)); + return; case 'quasiquote' ast = quasiquote(ast.get(2)); % TCO case 'defmacro!' diff --git a/impls/matlab/stepA_mal.m b/impls/matlab/stepA_mal.m index 09f25257..4cd94072 100644 --- a/impls/matlab/stepA_mal.m +++ b/impls/matlab/stepA_mal.m @@ -6,26 +6,40 @@ function ret = READ(str) end % eval -function ret = is_pair(ast) - ret = type_utils.sequential_Q(ast) && length(ast) > 0; +function ret = starts_with(ast, sym) + ret = length(ast); + if ret + first = ast.get(1); + ret = isa(first,'types.Symbol') && strcmp(first.name, sym); + end +end + +function ret = quasiquote_loop(ast) + ret = types.List(); + for i=length(ast):-1:1 + elt = ast.get(i) + if isa(elt, 'types.List') && starts_with(elt, 'splice-unquote') + ret = types.List(types.Symbol('concat'), elt.get(2), ret); + else + ret = types.List(types.Symbol('cons'), quasiquote(elt), ret); + end + end end function ret = quasiquote(ast) - if ~is_pair(ast) + switch class(ast) + case 'types.List' + if starts_with(ast, 'unquote') + ret = ast.get(2); + else + ret = quasiquote_loop(ast); + end + case 'types.Vector' + ret = types.List(types.Symbol('vec'), quasiquote_loop(ast)); + case {'types.Symbol', 'types.HashMap'} ret = types.List(types.Symbol('quote'), ast); - elseif isa(ast.get(1),'types.Symbol') && ... - strcmp(ast.get(1).name, 'unquote') - ret = ast.get(2); - elseif is_pair(ast.get(1)) && ... - isa(ast.get(1).get(1),'types.Symbol') && ... - strcmp(ast.get(1).get(1).name, 'splice-unquote') - ret = types.List(types.Symbol('concat'), ... - ast.get(1).get(2), ... - quasiquote(ast.slice(2))); - else - ret = types.List(types.Symbol('cons'), ... - quasiquote(ast.get(1)), ... - quasiquote(ast.slice(2))); + otherwise + ret = ast; end end @@ -112,6 +126,9 @@ function ret = EVAL(ast, env) case 'quote' ret = ast.get(2); return; + case 'quasiquoteexpand' + ret = quasiquote(ast.get(2)); + return; case 'quasiquote' ast = quasiquote(ast.get(2)); % TCO case 'defmacro!' diff --git a/impls/miniMAL/core.json b/impls/miniMAL/core.json index edc39aa7..d80efad7 100644 --- a/impls/miniMAL/core.json +++ b/impls/miniMAL/core.json @@ -171,6 +171,7 @@ ["`", "sequential?"], "sequential?", ["`", "cons"], "cons", ["`", "concat"], "concat", + ["`", "vec"], "vectorl", ["`", "nth"], "_nth", ["`", "first"], "_first", ["`", "rest"], "_rest", diff --git a/impls/miniMAL/step7_quote.json b/impls/miniMAL/step7_quote.json index f5cd83c2..8bf79f97 100644 --- a/impls/miniMAL/step7_quote.json +++ b/impls/miniMAL/step7_quote.json @@ -9,26 +9,32 @@ ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], -["def", "pair?", ["fn", ["x"], - ["if", ["sequential?", "x"], - ["if", [">", ["count", "x"], 0], true, false], - false]]], +["def", "starts-with", ["fn", ["ast", "sym"], + ["and", ["not", ["empty?", "ast"]], + ["let", ["a0", ["first", "ast"]], + ["and", ["symbol?", "a0"], + ["=", "sym", ["get", "a0", ["`", "val"]]]]]]]], + +["def", "quasiquote-loop", ["fn", ["xs"], + ["if", ["empty?", "xs"], + ["list"], + ["let", ["elt", ["first", "xs"], + "acc", ["quasiquote-loop", ["rest", "xs"]]], + ["if", ["and", ["list?", "elt"], + ["starts-with", "elt", ["`", "splice-unquote"]]], + ["list", ["symbol", ["`", "concat"]], ["nth", "elt", 1], "acc"], + ["list", ["symbol", ["`", "cons"]], ["quasiquote", "elt"], "acc"]]]]]], ["def", "quasiquote", ["fn", ["ast"], - ["if", ["not", ["pair?", "ast"]], + ["if", ["list?", "ast"], + ["if", ["starts-with", "ast", ["`", "unquote"]], + ["nth", "ast", 1], + ["quasiquote-loop", "ast"]], + ["if", ["vector?", "ast"], + ["list", ["symbol", ["`", "vec"]], ["quasiquote-loop", "ast"]], + ["if", ["or", ["map?", "ast"], ["symbol?", "ast"]], ["list", ["symbol", ["`", "quote"]], "ast"], - ["if", ["and", ["symbol?", ["nth", "ast", 0]], - ["=", ["`", "unquote"], ["get", ["nth", "ast", 0], ["`", "val"]]]], - ["nth", "ast", 1], - ["if", ["and", ["pair?", ["nth", "ast", 0]], - ["=", ["`", "splice-unquote"], - ["get", ["nth", ["nth", "ast", 0], 0], ["`", "val"]]]], - ["list", ["symbol", ["`", "concat"]], - ["nth", ["nth", "ast", 0], 1], - ["quasiquote", ["rest", "ast"]]], - ["list", ["symbol", ["`", "cons"]], - ["quasiquote", ["nth", "ast", 0]], - ["quasiquote", ["rest", "ast"]]]]]]]], + "ast"]]]]], ["def", "eval-ast", ["fn", ["ast", "env"], ["if", ["symbol?", "ast"], @@ -70,6 +76,8 @@ ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "quote"], "a0"], ["nth", "ast", 1], + ["if", ["=", ["`", "quasiquoteexpand"], "a0"], + ["quasiquote", ["nth", "ast", 1]], ["if", ["=", ["`", "quasiquote"], "a0"], ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], ["if", ["=", ["`", "do"], "a0"], @@ -97,7 +105,7 @@ ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], "args"]], - ["apply", "f", "args"]]]]]]]]]]]]]]], + ["apply", "f", "args"]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], diff --git a/impls/miniMAL/step8_macros.json b/impls/miniMAL/step8_macros.json index 77d8bccc..41fe026c 100644 --- a/impls/miniMAL/step8_macros.json +++ b/impls/miniMAL/step8_macros.json @@ -9,26 +9,32 @@ ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], -["def", "pair?", ["fn", ["x"], - ["if", ["sequential?", "x"], - ["if", [">", ["count", "x"], 0], true, false], - false]]], +["def", "starts-with", ["fn", ["ast", "sym"], + ["and", ["not", ["empty?", "ast"]], + ["let", ["a0", ["first", "ast"]], + ["and", ["symbol?", "a0"], + ["=", "sym", ["get", "a0", ["`", "val"]]]]]]]], + +["def", "quasiquote-loop", ["fn", ["xs"], + ["if", ["empty?", "xs"], + ["list"], + ["let", ["elt", ["first", "xs"], + "acc", ["quasiquote-loop", ["rest", "xs"]]], + ["if", ["and", ["list?", "elt"], + ["starts-with", "elt", ["`", "splice-unquote"]]], + ["list", ["symbol", ["`", "concat"]], ["nth", "elt", 1], "acc"], + ["list", ["symbol", ["`", "cons"]], ["quasiquote", "elt"], "acc"]]]]]], ["def", "quasiquote", ["fn", ["ast"], - ["if", ["not", ["pair?", "ast"]], + ["if", ["list?", "ast"], + ["if", ["starts-with", "ast", ["`", "unquote"]], + ["nth", "ast", 1], + ["quasiquote-loop", "ast"]], + ["if", ["vector?", "ast"], + ["list", ["symbol", ["`", "vec"]], ["quasiquote-loop", "ast"]], + ["if", ["or", ["map?", "ast"], ["symbol?", "ast"]], ["list", ["symbol", ["`", "quote"]], "ast"], - ["if", ["and", ["symbol?", ["nth", "ast", 0]], - ["=", ["`", "unquote"], ["get", ["nth", "ast", 0], ["`", "val"]]]], - ["nth", "ast", 1], - ["if", ["and", ["pair?", ["nth", "ast", 0]], - ["=", ["`", "splice-unquote"], - ["get", ["nth", ["nth", "ast", 0], 0], ["`", "val"]]]], - ["list", ["symbol", ["`", "concat"]], - ["nth", ["nth", "ast", 0], 1], - ["quasiquote", ["rest", "ast"]]], - ["list", ["symbol", ["`", "cons"]], - ["quasiquote", ["nth", "ast", 0]], - ["quasiquote", ["rest", "ast"]]]]]]]], + "ast"]]]]], ["def", "macro?", ["fn", ["ast", "env"], ["and", ["list?", "ast"], @@ -87,6 +93,8 @@ ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "quote"], "a0"], ["nth", "ast", 1], + ["if", ["=", ["`", "quasiquoteexpand"], "a0"], + ["quasiquote", ["nth", "ast", 1]], ["if", ["=", ["`", "quasiquote"], "a0"], ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], ["if", ["=", ["`", "defmacro!"], "a0"], @@ -121,7 +129,7 @@ ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], "args"]], - ["apply", "f", "args"]]]]]]]]]]]]]]]]]]], + ["apply", "f", "args"]]]]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], diff --git a/impls/miniMAL/step9_try.json b/impls/miniMAL/step9_try.json index 756c7eee..90eaf911 100644 --- a/impls/miniMAL/step9_try.json +++ b/impls/miniMAL/step9_try.json @@ -9,26 +9,32 @@ ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], -["def", "pair?", ["fn", ["x"], - ["if", ["sequential?", "x"], - ["if", [">", ["count", "x"], 0], true, false], - false]]], +["def", "starts-with", ["fn", ["ast", "sym"], + ["and", ["not", ["empty?", "ast"]], + ["let", ["a0", ["first", "ast"]], + ["and", ["symbol?", "a0"], + ["=", "sym", ["get", "a0", ["`", "val"]]]]]]]], + +["def", "quasiquote-loop", ["fn", ["xs"], + ["if", ["empty?", "xs"], + ["list"], + ["let", ["elt", ["first", "xs"], + "acc", ["quasiquote-loop", ["rest", "xs"]]], + ["if", ["and", ["list?", "elt"], + ["starts-with", "elt", ["`", "splice-unquote"]]], + ["list", ["symbol", ["`", "concat"]], ["nth", "elt", 1], "acc"], + ["list", ["symbol", ["`", "cons"]], ["quasiquote", "elt"], "acc"]]]]]], ["def", "quasiquote", ["fn", ["ast"], - ["if", ["not", ["pair?", "ast"]], + ["if", ["list?", "ast"], + ["if", ["starts-with", "ast", ["`", "unquote"]], + ["nth", "ast", 1], + ["quasiquote-loop", "ast"]], + ["if", ["vector?", "ast"], + ["list", ["symbol", ["`", "vec"]], ["quasiquote-loop", "ast"]], + ["if", ["or", ["map?", "ast"], ["symbol?", "ast"]], ["list", ["symbol", ["`", "quote"]], "ast"], - ["if", ["and", ["symbol?", ["nth", "ast", 0]], - ["=", ["`", "unquote"], ["get", ["nth", "ast", 0], ["`", "val"]]]], - ["nth", "ast", 1], - ["if", ["and", ["pair?", ["nth", "ast", 0]], - ["=", ["`", "splice-unquote"], - ["get", ["nth", ["nth", "ast", 0], 0], ["`", "val"]]]], - ["list", ["symbol", ["`", "concat"]], - ["nth", ["nth", "ast", 0], 1], - ["quasiquote", ["rest", "ast"]]], - ["list", ["symbol", ["`", "cons"]], - ["quasiquote", ["nth", "ast", 0]], - ["quasiquote", ["rest", "ast"]]]]]]]], + "ast"]]]]], ["def", "macro?", ["fn", ["ast", "env"], ["and", ["list?", "ast"], @@ -87,6 +93,8 @@ ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "quote"], "a0"], ["nth", "ast", 1], + ["if", ["=", ["`", "quasiquoteexpand"], "a0"], + ["quasiquote", ["nth", "ast", 1]], ["if", ["=", ["`", "quasiquote"], "a0"], ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], ["if", ["=", ["`", "defmacro!"], "a0"], @@ -134,7 +142,7 @@ ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], "args"]], - ["apply", "f", "args"]]]]]]]]]]]]]]]]]]]], + ["apply", "f", "args"]]]]]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], diff --git a/impls/miniMAL/stepA_mal.json b/impls/miniMAL/stepA_mal.json index 97ebe6f7..4212b935 100644 --- a/impls/miniMAL/stepA_mal.json +++ b/impls/miniMAL/stepA_mal.json @@ -9,26 +9,32 @@ ["def", "READ", ["fn", ["strng"], ["read-str", "strng"]]], -["def", "pair?", ["fn", ["x"], - ["if", ["sequential?", "x"], - ["if", [">", ["count", "x"], 0], true, false], - false]]], +["def", "starts-with", ["fn", ["ast", "sym"], + ["and", ["not", ["empty?", "ast"]], + ["let", ["a0", ["first", "ast"]], + ["and", ["symbol?", "a0"], + ["=", "sym", ["get", "a0", ["`", "val"]]]]]]]], + +["def", "quasiquote-loop", ["fn", ["xs"], + ["if", ["empty?", "xs"], + ["list"], + ["let", ["elt", ["first", "xs"], + "acc", ["quasiquote-loop", ["rest", "xs"]]], + ["if", ["and", ["list?", "elt"], + ["starts-with", "elt", ["`", "splice-unquote"]]], + ["list", ["symbol", ["`", "concat"]], ["nth", "elt", 1], "acc"], + ["list", ["symbol", ["`", "cons"]], ["quasiquote", "elt"], "acc"]]]]]], ["def", "quasiquote", ["fn", ["ast"], - ["if", ["not", ["pair?", "ast"]], + ["if", ["list?", "ast"], + ["if", ["starts-with", "ast", ["`", "unquote"]], + ["nth", "ast", 1], + ["quasiquote-loop", "ast"]], + ["if", ["vector?", "ast"], + ["list", ["symbol", ["`", "vec"]], ["quasiquote-loop", "ast"]], + ["if", ["or", ["map?", "ast"], ["symbol?", "ast"]], ["list", ["symbol", ["`", "quote"]], "ast"], - ["if", ["and", ["symbol?", ["nth", "ast", 0]], - ["=", ["`", "unquote"], ["get", ["nth", "ast", 0], ["`", "val"]]]], - ["nth", "ast", 1], - ["if", ["and", ["pair?", ["nth", "ast", 0]], - ["=", ["`", "splice-unquote"], - ["get", ["nth", ["nth", "ast", 0], 0], ["`", "val"]]]], - ["list", ["symbol", ["`", "concat"]], - ["nth", ["nth", "ast", 0], 1], - ["quasiquote", ["rest", "ast"]]], - ["list", ["symbol", ["`", "cons"]], - ["quasiquote", ["nth", "ast", 0]], - ["quasiquote", ["rest", "ast"]]]]]]]], + "ast"]]]]], ["def", "macro?", ["fn", ["ast", "env"], ["and", ["list?", "ast"], @@ -87,6 +93,8 @@ ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "quote"], "a0"], ["nth", "ast", 1], + ["if", ["=", ["`", "quasiquoteexpand"], "a0"], + ["quasiquote", ["nth", "ast", 1]], ["if", ["=", ["`", "quasiquote"], "a0"], ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], ["if", ["=", ["`", "defmacro!"], "a0"], @@ -134,7 +142,7 @@ ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], "args"]], - ["apply", "f", "args"]]]]]]]]]]]]]]]]]]]], + ["apply", "f", "args"]]]]]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], diff --git a/impls/nasm/core.asm b/impls/nasm/core.asm index 8282b1ba..de1f0e50 100644 --- a/impls/nasm/core.asm +++ b/impls/nasm/core.asm @@ -44,6 +44,7 @@ section .data static core_cons_symbol, db "cons" static core_concat_symbol, db "concat" + static core_vec_symbol, db "vec" static core_first_symbol, db "first" static core_rest_symbol, db "rest" @@ -113,6 +114,8 @@ section .data static core_concat_not_list, db "Error: concat expects lists or vectors" + static core_vec_wrong_arg, db "Error: vec expects a list or vector " + static core_first_missing_arg, db "Error: missing argument to first" static core_first_not_list, db "Error: first expects a list or vector" @@ -192,6 +195,7 @@ core_environment: core_env_native core_cons_symbol, core_cons core_env_native core_concat_symbol, core_concat + core_env_native core_vec_symbol, core_vec core_env_native core_first_symbol, core_first core_env_native core_rest_symbol, core_rest @@ -1795,6 +1799,36 @@ core_concat: mov rsi, rax jmp error_throw +;; Convert a sequence to vector +core_vec: + mov al, BYTE [rsi] + and al, content_mask + cmp al, content_pointer + jne .error + mov rsi, [rsi + Cons.car] + + mov al, BYTE [rsi] + and al, block_mask + container_mask + + ;; delegate lists to `vector` built-in + cmp al, container_list + je core_vector + + ;; expect a sequence + cmp al, container_vector + jne .error + + ;; return vectors unchanged + call incref_object + mov rax, rsi + ret + +.error + push rsi + print_str_mac error_string + print_str_mac core_vec_wrong_arg + pop rsi + jmp error_throw ;; Returns the first element of a list ;; diff --git a/impls/nasm/step7_quote.asm b/impls/nasm/step7_quote.asm index d86bdc96..d65b4a5e 100644 --- a/impls/nasm/step7_quote.asm +++ b/impls/nasm/step7_quote.asm @@ -60,10 +60,12 @@ section .data static_symbol quote_symbol, 'quote' static_symbol quasiquote_symbol, 'quasiquote' + static_symbol quasiquoteexpand_symbol, 'quasiquoteexpand' static_symbol unquote_symbol, 'unquote' static_symbol splice_unquote_symbol, 'splice-unquote' static_symbol concat_symbol, 'concat' static_symbol cons_symbol, 'cons' + static_symbol vec_symbol, 'vec' ;; Startup string. This is evaluated on startup static mal_startup_string, db "(do \ @@ -75,6 +77,28 @@ section .data static run_script_string, db "(load-file ",34 section .text + +;;; Extract the car of a Cons and increment its reference count. +;;; If it was value, create a fresh copy. +;;; in : rsi (which must be a pointer!) +;;; out : rsi +;;; modified: : cl, rax, rbx +car_and_incref: + mov cl, BYTE [rsi + Cons.typecar] + and cl, content_mask + + mov rsi, [rsi + Cons.car] + + cmp cl, content_pointer + je incref_object + + call alloc_cons + mov [rax + Cons.typecar], BYTE cl ; masked above + mov [rax + Cons.car], rsi + mov rsi, rax + ret + + ;; ---------------------------------------------- ;; Evaluates a form ;; @@ -602,6 +626,9 @@ eval: eval_cmp_symbol quote_symbol ; quote je .quote_symbol + eval_cmp_symbol quasiquoteexpand_symbol + je .quasiquoteexpand_symbol + eval_cmp_symbol quasiquote_symbol ; quasiquote je .quasiquote_symbol @@ -1328,6 +1355,20 @@ eval: jmp .return ; ----------------------------- + +;;; Like quasiquote, but do not evaluate the result. +.quasiquoteexpand_symbol: + ;; Return nil if no cdr + mov cl, BYTE [rsi + Cons.typecdr] + cmp cl, content_pointer + jne .return_nil + + mov rsi, [rsi + Cons.cdr] + call car_and_incref + call quasiquote + jmp .return + + ; ----------------------------- .quasiquote_symbol: ; call quasiquote function with first argument @@ -1553,363 +1594,254 @@ apply_fn: ; The new environment (in RDI) will be released by eval -;; Set ZF if RSI is a non-empty list or vector -;; Modifies RAX, does not modify RSI -is_pair: - mov al, BYTE [rsi] - test al, block_mask - jnz .false ; Not a Cons - cmp al, maltype_empty_list - je .false ; Empty list - cmp al, maltype_empty_vector - je .false ; Empty vector - - ; Something non empty - and al, container_mask - cmp al, container_list - je .true - cmp al, container_vector - je .true - ; Not a list or vector -> false - -.false: - lahf ; flags in AH - and ah, 255-64 ; clear zero flag - sahf - ret -.true: - lahf ; flags in AH - or ah, 64 ; set zero flag - sahf - ret - -;; Called by eval with AST in RSI [ modified ] -;; Returns new AST in RAX +;;; Called by eval +;;; Original AST in RSI. +;;; Returns new AST in RAX quasiquote: - ; i. Check if AST is an empty list - call is_pair - jne .quote_ast - - ; ii. Check if the first element of RSI is the symbol - ; 'unquote' - - mov al, BYTE [rsi] - and al, content_mask - cmp al, content_pointer - jne .not_unquote ; Not a pointer - - mov rdi, [rsi + Cons.car] ; Get the pointer - mov cl, BYTE [rdi] - cmp cl, maltype_symbol - jne .not_unquote - - ; Compare against 'unquote' - mov r8, rsi - mov r9, rax - - mov rsi, unquote_symbol - call compare_char_array - test rax, rax - - mov rax, r9 - mov rsi, r8 - - je .unquote - -.not_unquote: - ; iii. Handle splice-unquote - ; RSI -> ( ( splice-unquote ? ) ? ) - - ; Test if RSI contains a pointer - - cmp al, content_pointer - jne .not_splice - - mov rbx, [rsi + Cons.car] ; Get the object pointer - - ; RBX -> ( splice-unquote ? ) - - xchg rbx, rsi - call is_pair - xchg rbx, rsi - jne .not_splice ; First element not a pair - - ; Check if this list in RBX starts with 'splice-unquote' symbol - mov al, BYTE [rbx] - and al, content_mask - cmp al, content_pointer - jne .not_splice - - - mov rdi, [rbx + Cons.car] ; Get the pointer - mov al, BYTE [rdi] - cmp al, maltype_symbol - jne .not_splice - - mov r8, rsi - mov r9, rbx - - ; Compare against 'splice-unquote' - mov rsi, splice_unquote_symbol - call compare_char_array - test rax, rax - - mov rbx, r9 - mov rsi, r8 - - je .splice_unquote - -.not_splice: - - ; iv. Cons first and rest of AST in RSI - - ; check if pointer or value - mov cl, BYTE [rsi] - and cl, content_mask - cmp cl, content_pointer - je .cons_pointer - - ; a value, so copy - call alloc_cons - or cl, container_list - mov [rax], BYTE cl ; List + Content - mov rbx, [rsi + Cons.car] - mov [rax + Cons.car], rbx - mov rcx, rax - jmp .cons_first - -.cons_pointer: - ; Get the pointer and call quasiquote - push rsi - mov rsi, [rsi + Cons.car] - call quasiquote - mov rcx, rax - pop rsi - - call alloc_cons - mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rcx - mov rcx, rax - -.cons_first: - ; Have Cons with first object in RCX - - ; Call quasiquote on the rest of the AST - ; Check if this is the end of the list - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .cons_ast_end - - mov rsi, [rsi + Cons.cdr] ; Rest of the list - - call incref_object ; Will release after quasiquote call - - jmp .cons_quasiquote_ast - -.cons_ast_end: - ; End of the AST, so make an empty list - call alloc_cons - mov [rax], BYTE maltype_empty_list - mov rsi, rax - -.cons_quasiquote_ast: - push rcx - push rsi - call quasiquote - mov rdx, rax ; List in RDX - - pop rsi - call release_object ; Release input - - pop rcx ; Value in RCX - - ; cons RCX and RDX - ; Work from the end of the list to the front - - call alloc_cons - mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rdx ; The rest of AST - - ; Link to the RCX Cons - mov [rcx + Cons.typecdr], BYTE content_pointer - mov [rcx + Cons.cdr], rax - mov rdx, rcx - - call alloc_cons ; Cons for cons symbol - mov [rax + Cons.typecdr], BYTE content_pointer - mov [rax + Cons.cdr], rdx - mov rdx, rax - - ; Get the cons symbol - mov rsi, cons_symbol - call incref_object - - mov [rdx], BYTE (container_list + content_pointer) - mov [rdx + Cons.car], rsi - - mov rax, rdx - ret - -.quote_ast: - ; Return (quote RSI) - - call incref_object ; RSI reference count - - ; Cons for RSI - call alloc_cons - mov [rax], BYTE (block_cons + container_list + content_pointer) - mov [rax + Cons.car], rsi - mov rsi, rax - - ; Cons for quote symbol - call alloc_cons - mov rbx, rax - mov [rbx + Cons.typecdr], BYTE content_pointer - mov [rbx + Cons.cdr], rsi - - ; Get a quote symbol, incrementing references - mov rsi, quote_symbol - call incref_object - - ; Put into the Cons in RBX - mov [rbx + Cons.car], rsi - mov [rbx], BYTE (block_cons + container_list + content_pointer) - mov rax, rbx - ret - ; ----------------------- - -.unquote: - - ; Got unquote symbol. Return second element of RSI - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .empty_list ; No second element - - mov rsi, [rsi + Cons.cdr] - - ; Check if it's a value or pointer - mov cl, BYTE [rsi] - and cl, content_mask - cmp cl, content_pointer - je .unquote_pointer - - ; A value, so need a new Cons - call alloc_cons - mov [rax], BYTE cl ; content - mov rbx, [rsi + Cons.car] - mov [rax + Cons.car], rbx ; Copy content - ret - -.unquote_pointer: - mov rsi, [rsi + Cons.car] + ;; Dispatch on the type. + mov al, BYTE [rsi + Cons.typecar] + mov cl, al ; keep full al for .list + and cl, container_mask + cmp cl, container_list + je .list + cmp cl, container_map + je .map + cmp cl, container_symbol + je .symbol + cmp cl, container_vector + je .vector + ;; return other types unchanged call incref_object mov rax, rsi ret - ; ----------------------- -.splice_unquote: - ; RSI -> ( RBX->( splice-unquote A ) B ) - ; - ; RBX Car points to splice-unquote symbol +.list: + ;; AST is a list, process it with qq_foldr unless.. + mov cl, al ; it is not empty, + and cl, content_mask + cmp cl, content_empty + je qq_foldr - ; Check if there is anything after the symbol - mov al, BYTE [rbx + Cons.typecdr] - cmp al, content_pointer - jne .splice_unquote_empty + cmp cl, content_pointer ; and it is a pointer, + jne qq_foldr - ; Point to the second element of the splice-unquote list - mov rcx, [rbx + Cons.cdr] - - ; Check whether it's a value or pointer - mov al, BYTE [rcx] - and al, content_mask - cmp al, content_pointer - je .splice_unquote_pointer + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne qq_foldr - ; A value, so change the container to a value - mov [rcx], BYTE al - ; Remove pointer from RBX - mov [rbx + Cons.typecdr], BYTE 0 - jmp .splice_unquote_first ; Got the value in RCX - -.splice_unquote_pointer: - mov rcx, [rcx + Cons.car] ; Get the object pointed to - xchg rcx, rsi - call incref_object - xchg rcx, rsi ; Object in RCX - -.splice_unquote_first: ; Got the first object in RCX + mov r8, rsi ; and the symbol is 'unquote, + mov rsi, unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne qq_foldr - ; Check if RSI contains anything else - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .splice_unquote_notail + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne qq_foldr + ;; If so, return the argument. mov rsi, [rsi + Cons.cdr] - - ; Now have: - ; ( ( splice-unquote A ) B ) - ; RCX->A RSI->( B ) - ; Need to call quasiquote on the rest of the list - push rcx - call quasiquote - mov rdx, rax - pop rcx - ; Need to concat rcx and rdx - ; Work from the end of the list to the front - - call alloc_cons - mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rdx ; The rest of AST - mov rdx, rax ; Push list into RDX - - call alloc_cons - mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rcx ; The splice-unquote object - mov [rax + Cons.typecdr], BYTE content_pointer - mov [rax + Cons.cdr], rdx - mov rdx, rax - - call alloc_cons ; Cons for concat symbol - mov [rax + Cons.typecdr], BYTE content_pointer - mov [rax + Cons.cdr], rdx - mov rdx, rax - - ; Get the concat symbol - mov rsi, concat_symbol - call incref_object - - mov [rdx], BYTE (container_list + content_pointer) - mov [rdx + Cons.car], rsi - - mov rax, rdx - ret - -.splice_unquote_notail: - ; Just return the object in RCX - ; since nothing to concatenate with - mov rax, rcx + call car_and_incref + mov rax, rsi ret -.splice_unquote_empty: - ; Nothing in the (splice-unquote) list, so ignore - ; Just call quasiquote on the rest of RSI +.map: +.symbol: + call incref_object + ;; rdx := (ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rsi + mov rdx, rax + + mov rsi, quote_symbol + call incref_object + + ;; rax := ('quote ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + +.vector: + ;; rdx := ast processed like a list + call qq_foldr + mov rdx, rax + + ;; rdx := (processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rdx + mov rdx, rax + + mov rsi, vec_symbol + call incref_object + + ;; rax := ('vec processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + + +;;; Helper for quasiquote. +;;; RSI must contain a list or vector, which may be empty. +;;; The result in RAX is always a list. +;;; Iterate on the elements in the right fold/reduce style. +qq_foldr: + mov cl, BYTE [rsi + Cons.typecar] + + cmp cl, maltype_empty_list + je .empty_list + + cmp cl, maltype_empty_vector + je .empty_vector + + ;; Extract first element and store it into the stack during + ;; the recursion. + mov rdx, rsi + call car_and_incref + push rsi + mov rsi, rdx + + ;; Extract the rest of the list. mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .empty_list ; Nothing else +;;; If the rest is not empty + cmp al, content_pointer + jne .else +;;; then mov rsi, [rsi + Cons.cdr] - jmp quasiquote ; Tail call - -.empty_list: - ; Return an empty list + jmp .endif +.else: + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rsi, rax +.endif: + call qq_foldr ; recursive call + pop rsi + jmp qq_loop + +.empty_list: ;; () -> () + call incref_object + mov rax, rsi + ret + +.empty_vector: ;; [] -> () call alloc_cons mov [rax], BYTE maltype_empty_list ret - - + +;; Helper for quasiquote +;; The transition function starts here. +;; Current element is in rsi, accumulator in rax. +qq_loop: + mov r9, rax + + ;; Process with the element with .default, unless.. + mov cl, BYTE [rsi + Cons.typecar] ; it is a list + mov al, cl + and al, container_mask + cmp al, container_list + jne .default + + cmp cl, maltype_empty_list ; it is not empty, + je .default + + and cl, content_mask ; and it is a pointer, + cmp cl, content_pointer + jne .default + + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne .default + + mov r8, rsi ; and the symbol is 'splice-unquote, + mov rsi, splice_unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne .default + + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne .default + + ;; If so, return ('concat elt acc). + mov rsi, [rsi + Cons.cdr] + call car_and_incref + + ;; rdx := (acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.car], r9 + mov rdx, rax + + ;; rdx := (elt acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + mov rdx, rax + + mov rsi, concat_symbol + call incref_object + + ;; rax := ('concat elt acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + +.default: + ;; rax := (accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.car], r9 + + ;; rcx := quasiquoted_element + ;; rdx := (accumulator) + push rax + call quasiquote + mov rcx, rax + pop rdx + + ;; rdx := (quasiquoted_element accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rcx + mov [rax + Cons.cdr], rdx + mov rdx, rax + + mov rsi, cons_symbol + call incref_object + + ;; rax := ('cons quasiquoted_elt accumulator) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + + ;; Read and eval read_eval: ; ------------- diff --git a/impls/nasm/step8_macros.asm b/impls/nasm/step8_macros.asm index 9dd4d8b0..ba4ee897 100644 --- a/impls/nasm/step8_macros.asm +++ b/impls/nasm/step8_macros.asm @@ -64,10 +64,12 @@ section .data static_symbol quote_symbol, 'quote' static_symbol quasiquote_symbol, 'quasiquote' + static_symbol quasiquoteexpand_symbol, 'quasiquoteexpand' static_symbol unquote_symbol, 'unquote' static_symbol splice_unquote_symbol, 'splice-unquote' static_symbol concat_symbol, 'concat' static_symbol cons_symbol, 'cons' + static_symbol vec_symbol, 'vec' ;; Startup string. This is evaluated on startup static mal_startup_string, db "(do \ @@ -80,6 +82,28 @@ section .data static run_script_string, db "(load-file ",34 section .text + +;;; Extract the car of a Cons and increment its reference count. +;;; If it was value, create a fresh copy. +;;; in : rsi (which must be a pointer!) +;;; out : rsi +;;; modified: : cl, rax, rbx +car_and_incref: + mov cl, BYTE [rsi + Cons.typecar] + and cl, content_mask + + mov rsi, [rsi + Cons.car] + + cmp cl, content_pointer + je incref_object + + call alloc_cons + mov [rax + Cons.typecar], BYTE cl ; masked above + mov [rax + Cons.car], rsi + mov rsi, rax + ret + + ;; ---------------------------------------------- ;; Evaluates a form ;; @@ -629,6 +653,9 @@ eval: eval_cmp_symbol quote_symbol ; quote je .quote_symbol + eval_cmp_symbol quasiquoteexpand_symbol + je .quasiquoteexpand_symbol + eval_cmp_symbol quasiquote_symbol ; quasiquote je .quasiquote_symbol @@ -1395,6 +1422,20 @@ eval: jmp .return ; ----------------------------- + +;;; Like quasiquote, but do not evaluate the result. +.quasiquoteexpand_symbol: + ;; Return nil if no cdr + mov cl, BYTE [rsi + Cons.typecdr] + cmp cl, content_pointer + jne .return_nil + + mov rsi, [rsi + Cons.cdr] + call car_and_incref + call quasiquote + jmp .return + + ; ----------------------------- .quasiquote_symbol: ; call quasiquote function with first argument @@ -1651,363 +1692,254 @@ apply_fn: ; The new environment (in RDI) will be released by eval -;; Set ZF if RSI is a non-empty list or vector -;; Modifies RAX, does not modify RSI -is_pair: - mov al, BYTE [rsi] - test al, block_mask - jnz .false ; Not a Cons - cmp al, maltype_empty_list - je .false ; Empty list - cmp al, maltype_empty_vector - je .false ; Empty vector - - ; Something non empty - and al, container_mask - cmp al, container_list - je .true - cmp al, container_vector - je .true - ; Not a list or vector -> false - -.false: - lahf ; flags in AH - and ah, 255-64 ; clear zero flag - sahf - ret -.true: - lahf ; flags in AH - or ah, 64 ; set zero flag - sahf - ret - -;; Called by eval with AST in RSI [ modified ] -;; Returns new AST in RAX +;;; Called by eval +;;; Original AST in RSI. +;;; Returns new AST in RAX quasiquote: - ; i. Check if AST is an empty list - call is_pair - jne .quote_ast - - ; ii. Check if the first element of RSI is the symbol - ; 'unquote' - - mov al, BYTE [rsi] - and al, content_mask - cmp al, content_pointer - jne .not_unquote ; Not a pointer - - mov rdi, [rsi + Cons.car] ; Get the pointer - mov cl, BYTE [rdi] - cmp cl, maltype_symbol - jne .not_unquote - - ; Compare against 'unquote' - mov r8, rsi - mov r9, rax - - mov rsi, unquote_symbol - call compare_char_array - test rax, rax - - mov rax, r9 - mov rsi, r8 - - je .unquote - -.not_unquote: - ; iii. Handle splice-unquote - ; RSI -> ( ( splice-unquote ? ) ? ) - - ; Test if RSI contains a pointer - - cmp al, content_pointer - jne .not_splice - - mov rbx, [rsi + Cons.car] ; Get the object pointer - - ; RBX -> ( splice-unquote ? ) - - xchg rbx, rsi - call is_pair - xchg rbx, rsi - jne .not_splice ; First element not a pair - - ; Check if this list in RBX starts with 'splice-unquote' symbol - mov al, BYTE [rbx] - and al, content_mask - cmp al, content_pointer - jne .not_splice - - - mov rdi, [rbx + Cons.car] ; Get the pointer - mov al, BYTE [rdi] - cmp al, maltype_symbol - jne .not_splice - - mov r8, rsi - mov r9, rbx - - ; Compare against 'splice-unquote' - mov rsi, splice_unquote_symbol - call compare_char_array - test rax, rax - - mov rbx, r9 - mov rsi, r8 - - je .splice_unquote - -.not_splice: - - ; iv. Cons first and rest of AST in RSI - - ; check if pointer or value - mov cl, BYTE [rsi] - and cl, content_mask - cmp cl, content_pointer - je .cons_pointer - - ; a value, so copy - call alloc_cons - or cl, container_list - mov [rax], BYTE cl ; List + Content - mov rbx, [rsi + Cons.car] - mov [rax + Cons.car], rbx - mov rcx, rax - jmp .cons_first - -.cons_pointer: - ; Get the pointer and call quasiquote - push rsi - mov rsi, [rsi + Cons.car] - call quasiquote - mov rcx, rax - pop rsi - - call alloc_cons - mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rcx - mov rcx, rax - -.cons_first: - ; Have Cons with first object in RCX - - ; Call quasiquote on the rest of the AST - ; Check if this is the end of the list - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .cons_ast_end - - mov rsi, [rsi + Cons.cdr] ; Rest of the list - - call incref_object ; Will release after quasiquote call - - jmp .cons_quasiquote_ast - -.cons_ast_end: - ; End of the AST, so make an empty list - call alloc_cons - mov [rax], BYTE maltype_empty_list - mov rsi, rax - -.cons_quasiquote_ast: - push rcx - push rsi - call quasiquote - mov rdx, rax ; List in RDX - - pop rsi - call release_object ; Release input - - pop rcx ; Value in RCX - - ; cons RCX and RDX - ; Work from the end of the list to the front - - call alloc_cons - mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rdx ; The rest of AST - - ; Link to the RCX Cons - mov [rcx + Cons.typecdr], BYTE content_pointer - mov [rcx + Cons.cdr], rax - mov rdx, rcx - - call alloc_cons ; Cons for cons symbol - mov [rax + Cons.typecdr], BYTE content_pointer - mov [rax + Cons.cdr], rdx - mov rdx, rax - - ; Get the cons symbol - mov rsi, cons_symbol - call incref_object - - mov [rdx], BYTE (container_list + content_pointer) - mov [rdx + Cons.car], rsi - - mov rax, rdx - ret - -.quote_ast: - ; Return (quote RSI) - - call incref_object ; RSI reference count - - ; Cons for RSI - call alloc_cons - mov [rax], BYTE (block_cons + container_list + content_pointer) - mov [rax + Cons.car], rsi - mov rsi, rax - - ; Cons for quote symbol - call alloc_cons - mov rbx, rax - mov [rbx + Cons.typecdr], BYTE content_pointer - mov [rbx + Cons.cdr], rsi - - ; Get a quote symbol, incrementing references - mov rsi, quote_symbol - call incref_object - - ; Put into the Cons in RBX - mov [rbx + Cons.car], rsi - mov [rbx], BYTE (block_cons + container_list + content_pointer) - mov rax, rbx - ret - ; ----------------------- - -.unquote: - - ; Got unquote symbol. Return second element of RSI - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .empty_list ; No second element - - mov rsi, [rsi + Cons.cdr] - - ; Check if it's a value or pointer - mov cl, BYTE [rsi] - and cl, content_mask - cmp cl, content_pointer - je .unquote_pointer - - ; A value, so need a new Cons - call alloc_cons - mov [rax], BYTE cl ; content - mov rbx, [rsi + Cons.car] - mov [rax + Cons.car], rbx ; Copy content - ret - -.unquote_pointer: - mov rsi, [rsi + Cons.car] + ;; Dispatch on the type. + mov al, BYTE [rsi + Cons.typecar] + mov cl, al ; keep full al for .list + and cl, container_mask + cmp cl, container_list + je .list + cmp cl, container_map + je .map + cmp cl, container_symbol + je .symbol + cmp cl, container_vector + je .vector + ;; return other types unchanged call incref_object mov rax, rsi ret - ; ----------------------- -.splice_unquote: - ; RSI -> ( RBX->( splice-unquote A ) B ) - ; - ; RBX Car points to splice-unquote symbol +.list: + ;; AST is a list, process it with qq_foldr unless.. + mov cl, al ; it is not empty, + and cl, content_mask + cmp cl, content_empty + je qq_foldr - ; Check if there is anything after the symbol - mov al, BYTE [rbx + Cons.typecdr] - cmp al, content_pointer - jne .splice_unquote_empty + cmp cl, content_pointer ; and it is a pointer, + jne qq_foldr - ; Point to the second element of the splice-unquote list - mov rcx, [rbx + Cons.cdr] - - ; Check whether it's a value or pointer - mov al, BYTE [rcx] - and al, content_mask - cmp al, content_pointer - je .splice_unquote_pointer + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne qq_foldr - ; A value, so change the container to a value - mov [rcx], BYTE al - ; Remove pointer from RBX - mov [rbx + Cons.typecdr], BYTE 0 - jmp .splice_unquote_first ; Got the value in RCX - -.splice_unquote_pointer: - mov rcx, [rcx + Cons.car] ; Get the object pointed to - xchg rcx, rsi - call incref_object - xchg rcx, rsi ; Object in RCX - -.splice_unquote_first: ; Got the first object in RCX + mov r8, rsi ; and the symbol is 'unquote, + mov rsi, unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne qq_foldr - ; Check if RSI contains anything else - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .splice_unquote_notail + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne qq_foldr + ;; If so, return the argument. mov rsi, [rsi + Cons.cdr] - - ; Now have: - ; ( ( splice-unquote A ) B ) - ; RCX->A RSI->( B ) - ; Need to call quasiquote on the rest of the list - push rcx - call quasiquote - mov rdx, rax - pop rcx - ; Need to concat rcx and rdx - ; Work from the end of the list to the front - - call alloc_cons - mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rdx ; The rest of AST - mov rdx, rax ; Push list into RDX + call car_and_incref + mov rax, rsi + ret +.map: +.symbol: + call incref_object + + ;; rdx := (ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rsi + mov rdx, rax + + mov rsi, quote_symbol + call incref_object + + ;; rax := ('quote ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + +.vector: + ;; rdx := ast processed like a list + call qq_foldr + mov rdx, rax + + ;; rdx := (processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rdx + mov rdx, rax + + mov rsi, vec_symbol + call incref_object + + ;; rax := ('vec processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + + +;;; Helper for quasiquote. +;;; RSI must contain a list or vector, which may be empty. +;;; The result in RAX is always a list. +;;; Iterate on the elements in the right fold/reduce style. +qq_foldr: + mov cl, BYTE [rsi + Cons.typecar] + + cmp cl, maltype_empty_list + je .empty_list + + cmp cl, maltype_empty_vector + je .empty_vector + + ;; Extract first element and store it into the stack during + ;; the recursion. + mov rdx, rsi + call car_and_incref + push rsi + mov rsi, rdx + + ;; Extract the rest of the list. + mov al, BYTE [rsi + Cons.typecdr] + +;;; If the rest is not empty + cmp al, content_pointer + jne .else +;;; then + mov rsi, [rsi + Cons.cdr] + jmp .endif +.else: + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rsi, rax +.endif: + call qq_foldr ; recursive call + pop rsi + jmp qq_loop + +.empty_list: ;; () -> () + call incref_object + mov rax, rsi + ret + +.empty_vector: ;; [] -> () + call alloc_cons + mov [rax], BYTE maltype_empty_list + ret + + +;; Helper for quasiquote +;; The transition function starts here. +;; Current element is in rsi, accumulator in rax. +qq_loop: + mov r9, rax + + ;; Process with the element with .default, unless.. + mov cl, BYTE [rsi + Cons.typecar] ; it is a list + mov al, cl + and al, container_mask + cmp al, container_list + jne .default + + cmp cl, maltype_empty_list ; it is not empty, + je .default + + and cl, content_mask ; and it is a pointer, + cmp cl, content_pointer + jne .default + + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne .default + + mov r8, rsi ; and the symbol is 'splice-unquote, + mov rsi, splice_unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne .default + + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne .default + + ;; If so, return ('concat elt acc). + mov rsi, [rsi + Cons.cdr] + call car_and_incref + + ;; rdx := (acc) call alloc_cons mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rcx ; The splice-unquote object - mov [rax + Cons.typecdr], BYTE content_pointer - mov [rax + Cons.cdr], rdx + mov [rax + Cons.car], r9 mov rdx, rax - - call alloc_cons ; Cons for concat symbol + + ;; rdx := (elt acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi mov [rax + Cons.cdr], rdx mov rdx, rax - ; Get the concat symbol mov rsi, concat_symbol call incref_object - mov [rdx], BYTE (container_list + content_pointer) - mov [rdx + Cons.car], rsi - - mov rax, rdx - ret - -.splice_unquote_notail: - ; Just return the object in RCX - ; since nothing to concatenate with - mov rax, rcx - ret - -.splice_unquote_empty: - ; Nothing in the (splice-unquote) list, so ignore - ; Just call quasiquote on the rest of RSI - - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .empty_list ; Nothing else - - mov rsi, [rsi + Cons.cdr] - jmp quasiquote ; Tail call - -.empty_list: - ; Return an empty list + ;; rax := ('concat elt acc) call alloc_cons - mov [rax], BYTE maltype_empty_list -.return: + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + ret - +.default: + ;; rax := (accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.car], r9 + + ;; rcx := quasiquoted_element + ;; rdx := (accumulator) + push rax + call quasiquote + mov rcx, rax + pop rdx + + ;; rdx := (quasiquoted_element accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rcx + mov [rax + Cons.cdr], rdx + mov rdx, rax + + mov rsi, cons_symbol + call incref_object + + ;; rax := ('cons quasiquoted_elt accumulator) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + + ;; Tests if an AST in RSI is a list containing ;; a macro defined in the ENV in R15 ;; diff --git a/impls/nasm/step9_try.asm b/impls/nasm/step9_try.asm index 8127e053..54a33189 100644 --- a/impls/nasm/step9_try.asm +++ b/impls/nasm/step9_try.asm @@ -70,10 +70,12 @@ section .data static_symbol quote_symbol, 'quote' static_symbol quasiquote_symbol, 'quasiquote' + static_symbol quasiquoteexpand_symbol, 'quasiquoteexpand' static_symbol unquote_symbol, 'unquote' static_symbol splice_unquote_symbol, 'splice-unquote' static_symbol concat_symbol, 'concat' static_symbol cons_symbol, 'cons' + static_symbol vec_symbol, 'vec' ;; Startup string. This is evaluated on startup static mal_startup_string, db "(do \ @@ -86,6 +88,28 @@ section .data static run_script_string, db "(load-file ",34 section .text + +;;; Extract the car of a Cons and increment its reference count. +;;; If it was value, create a fresh copy. +;;; in : rsi (which must be a pointer!) +;;; out : rsi +;;; modified: : cl, rax, rbx +car_and_incref: + mov cl, BYTE [rsi + Cons.typecar] + and cl, content_mask + + mov rsi, [rsi + Cons.car] + + cmp cl, content_pointer + je incref_object + + call alloc_cons + mov [rax + Cons.typecar], BYTE cl ; masked above + mov [rax + Cons.car], rsi + mov rsi, rax + ret + + ;; ---------------------------------------------- ;; Evaluates a form ;; @@ -654,6 +678,9 @@ eval: eval_cmp_symbol quote_symbol ; quote je .quote_symbol + eval_cmp_symbol quasiquoteexpand_symbol + je .quasiquoteexpand_symbol + eval_cmp_symbol quasiquote_symbol ; quasiquote je .quasiquote_symbol @@ -1423,6 +1450,20 @@ eval: jmp .return ; ----------------------------- + +;;; Like quasiquote, but do not evaluate the result. +.quasiquoteexpand_symbol: + ;; Return nil if no cdr + mov cl, BYTE [rsi + Cons.typecdr] + cmp cl, content_pointer + jne .return_nil + + mov rsi, [rsi + Cons.cdr] + call car_and_incref + call quasiquote + jmp .return + + ; ----------------------------- .quasiquote_symbol: ; call quasiquote function with first argument @@ -1892,363 +1933,254 @@ apply_fn: ; The new environment (in RDI) will be released by eval -;; Set ZF if RSI is a non-empty list or vector -;; Modifies RAX, does not modify RSI -is_pair: - mov al, BYTE [rsi] - test al, block_mask - jnz .false ; Not a Cons - cmp al, maltype_empty_list - je .false ; Empty list - cmp al, maltype_empty_vector - je .false ; Empty vector - - ; Something non empty - and al, container_mask - cmp al, container_list - je .true - cmp al, container_vector - je .true - ; Not a list or vector -> false - -.false: - lahf ; flags in AH - and ah, 255-64 ; clear zero flag - sahf - ret -.true: - lahf ; flags in AH - or ah, 64 ; set zero flag - sahf - ret - -;; Called by eval with AST in RSI [ modified ] -;; Returns new AST in RAX +;;; Called by eval +;;; Original AST in RSI. +;;; Returns new AST in RAX quasiquote: - ; i. Check if AST is an empty list - call is_pair - jne .quote_ast - - ; ii. Check if the first element of RSI is the symbol - ; 'unquote' - - mov al, BYTE [rsi] - and al, content_mask - cmp al, content_pointer - jne .not_unquote ; Not a pointer - - mov rdi, [rsi + Cons.car] ; Get the pointer - mov cl, BYTE [rdi] - cmp cl, maltype_symbol - jne .not_unquote - - ; Compare against 'unquote' - mov r8, rsi - mov r9, rax - - mov rsi, unquote_symbol - call compare_char_array - test rax, rax - - mov rax, r9 - mov rsi, r8 - - je .unquote - -.not_unquote: - ; iii. Handle splice-unquote - ; RSI -> ( ( splice-unquote ? ) ? ) - - ; Test if RSI contains a pointer - - cmp al, content_pointer - jne .not_splice - - mov rbx, [rsi + Cons.car] ; Get the object pointer - - ; RBX -> ( splice-unquote ? ) - - xchg rbx, rsi - call is_pair - xchg rbx, rsi - jne .not_splice ; First element not a pair - - ; Check if this list in RBX starts with 'splice-unquote' symbol - mov al, BYTE [rbx] - and al, content_mask - cmp al, content_pointer - jne .not_splice - - - mov rdi, [rbx + Cons.car] ; Get the pointer - mov al, BYTE [rdi] - cmp al, maltype_symbol - jne .not_splice - - mov r8, rsi - mov r9, rbx - - ; Compare against 'splice-unquote' - mov rsi, splice_unquote_symbol - call compare_char_array - test rax, rax - - mov rbx, r9 - mov rsi, r8 - - je .splice_unquote - -.not_splice: - - ; iv. Cons first and rest of AST in RSI - - ; check if pointer or value - mov cl, BYTE [rsi] - and cl, content_mask - cmp cl, content_pointer - je .cons_pointer - - ; a value, so copy - call alloc_cons - or cl, container_list - mov [rax], BYTE cl ; List + Content - mov rbx, [rsi + Cons.car] - mov [rax + Cons.car], rbx - mov rcx, rax - jmp .cons_first - -.cons_pointer: - ; Get the pointer and call quasiquote - push rsi - mov rsi, [rsi + Cons.car] - call quasiquote - mov rcx, rax - pop rsi - - call alloc_cons - mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rcx - mov rcx, rax - -.cons_first: - ; Have Cons with first object in RCX - - ; Call quasiquote on the rest of the AST - ; Check if this is the end of the list - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .cons_ast_end - - mov rsi, [rsi + Cons.cdr] ; Rest of the list - - call incref_object ; Will release after quasiquote call - - jmp .cons_quasiquote_ast - -.cons_ast_end: - ; End of the AST, so make an empty list - call alloc_cons - mov [rax], BYTE maltype_empty_list - mov rsi, rax - -.cons_quasiquote_ast: - push rcx - push rsi - call quasiquote - mov rdx, rax ; List in RDX - - pop rsi - call release_object ; Release input - - pop rcx ; Value in RCX - - ; cons RCX and RDX - ; Work from the end of the list to the front - - call alloc_cons - mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rdx ; The rest of AST - - ; Link to the RCX Cons - mov [rcx + Cons.typecdr], BYTE content_pointer - mov [rcx + Cons.cdr], rax - mov rdx, rcx - - call alloc_cons ; Cons for cons symbol - mov [rax + Cons.typecdr], BYTE content_pointer - mov [rax + Cons.cdr], rdx - mov rdx, rax - - ; Get the cons symbol - mov rsi, cons_symbol - call incref_object - - mov [rdx], BYTE (container_list + content_pointer) - mov [rdx + Cons.car], rsi - - mov rax, rdx - ret - -.quote_ast: - ; Return (quote RSI) - - call incref_object ; RSI reference count - - ; Cons for RSI - call alloc_cons - mov [rax], BYTE (block_cons + container_list + content_pointer) - mov [rax + Cons.car], rsi - mov rsi, rax - - ; Cons for quote symbol - call alloc_cons - mov rbx, rax - mov [rbx + Cons.typecdr], BYTE content_pointer - mov [rbx + Cons.cdr], rsi - - ; Get a quote symbol, incrementing references - mov rsi, quote_symbol - call incref_object - - ; Put into the Cons in RBX - mov [rbx + Cons.car], rsi - mov [rbx], BYTE (block_cons + container_list + content_pointer) - mov rax, rbx - ret - ; ----------------------- - -.unquote: - - ; Got unquote symbol. Return second element of RSI - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .empty_list ; No second element - - mov rsi, [rsi + Cons.cdr] - - ; Check if it's a value or pointer - mov cl, BYTE [rsi] - and cl, content_mask - cmp cl, content_pointer - je .unquote_pointer - - ; A value, so need a new Cons - call alloc_cons - mov [rax], BYTE cl ; content - mov rbx, [rsi + Cons.car] - mov [rax + Cons.car], rbx ; Copy content - ret - -.unquote_pointer: - mov rsi, [rsi + Cons.car] + ;; Dispatch on the type. + mov al, BYTE [rsi + Cons.typecar] + mov cl, al ; keep full al for .list + and cl, container_mask + cmp cl, container_list + je .list + cmp cl, container_map + je .map + cmp cl, container_symbol + je .symbol + cmp cl, container_vector + je .vector + ;; return other types unchanged call incref_object mov rax, rsi ret - ; ----------------------- -.splice_unquote: - ; RSI -> ( RBX->( splice-unquote A ) B ) - ; - ; RBX Car points to splice-unquote symbol +.list: + ;; AST is a list, process it with qq_foldr unless.. + mov cl, al ; it is not empty, + and cl, content_mask + cmp cl, content_empty + je qq_foldr - ; Check if there is anything after the symbol - mov al, BYTE [rbx + Cons.typecdr] - cmp al, content_pointer - jne .splice_unquote_empty + cmp cl, content_pointer ; and it is a pointer, + jne qq_foldr - ; Point to the second element of the splice-unquote list - mov rcx, [rbx + Cons.cdr] - - ; Check whether it's a value or pointer - mov al, BYTE [rcx] - and al, content_mask - cmp al, content_pointer - je .splice_unquote_pointer + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne qq_foldr - ; A value, so change the container to a value - mov [rcx], BYTE al - ; Remove pointer from RBX - mov [rbx + Cons.typecdr], BYTE 0 - jmp .splice_unquote_first ; Got the value in RCX - -.splice_unquote_pointer: - mov rcx, [rcx + Cons.car] ; Get the object pointed to - xchg rcx, rsi - call incref_object - xchg rcx, rsi ; Object in RCX - -.splice_unquote_first: ; Got the first object in RCX + mov r8, rsi ; and the symbol is 'unquote, + mov rsi, unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne qq_foldr - ; Check if RSI contains anything else - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .splice_unquote_notail + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne qq_foldr + ;; If so, return the argument. mov rsi, [rsi + Cons.cdr] - - ; Now have: - ; ( ( splice-unquote A ) B ) - ; RCX->A RSI->( B ) - ; Need to call quasiquote on the rest of the list - push rcx - call quasiquote - mov rdx, rax - pop rcx - ; Need to concat rcx and rdx - ; Work from the end of the list to the front - - call alloc_cons - mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rdx ; The rest of AST - mov rdx, rax ; Push list into RDX + call car_and_incref + mov rax, rsi + ret +.map: +.symbol: + call incref_object + + ;; rdx := (ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rsi + mov rdx, rax + + mov rsi, quote_symbol + call incref_object + + ;; rax := ('quote ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + +.vector: + ;; rdx := ast processed like a list + call qq_foldr + mov rdx, rax + + ;; rdx := (processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rdx + mov rdx, rax + + mov rsi, vec_symbol + call incref_object + + ;; rax := ('vec processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + + +;;; Helper for quasiquote. +;;; RSI must contain a list or vector, which may be empty. +;;; The result in RAX is always a list. +;;; Iterate on the elements in the right fold/reduce style. +qq_foldr: + mov cl, BYTE [rsi + Cons.typecar] + + cmp cl, maltype_empty_list + je .empty_list + + cmp cl, maltype_empty_vector + je .empty_vector + + ;; Extract first element and store it into the stack during + ;; the recursion. + mov rdx, rsi + call car_and_incref + push rsi + mov rsi, rdx + + ;; Extract the rest of the list. + mov al, BYTE [rsi + Cons.typecdr] + +;;; If the rest is not empty + cmp al, content_pointer + jne .else +;;; then + mov rsi, [rsi + Cons.cdr] + jmp .endif +.else: + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rsi, rax +.endif: + call qq_foldr ; recursive call + pop rsi + jmp qq_loop + +.empty_list: ;; () -> () + call incref_object + mov rax, rsi + ret + +.empty_vector: ;; [] -> () + call alloc_cons + mov [rax], BYTE maltype_empty_list + ret + + +;; Helper for quasiquote +;; The transition function starts here. +;; Current element is in rsi, accumulator in rax. +qq_loop: + mov r9, rax + + ;; Process with the element with .default, unless.. + mov cl, BYTE [rsi + Cons.typecar] ; it is a list + mov al, cl + and al, container_mask + cmp al, container_list + jne .default + + cmp cl, maltype_empty_list ; it is not empty, + je .default + + and cl, content_mask ; and it is a pointer, + cmp cl, content_pointer + jne .default + + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne .default + + mov r8, rsi ; and the symbol is 'splice-unquote, + mov rsi, splice_unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne .default + + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne .default + + ;; If so, return ('concat elt acc). + mov rsi, [rsi + Cons.cdr] + call car_and_incref + + ;; rdx := (acc) call alloc_cons mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rcx ; The splice-unquote object - mov [rax + Cons.typecdr], BYTE content_pointer - mov [rax + Cons.cdr], rdx + mov [rax + Cons.car], r9 mov rdx, rax - - call alloc_cons ; Cons for concat symbol + + ;; rdx := (elt acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi mov [rax + Cons.cdr], rdx mov rdx, rax - ; Get the concat symbol mov rsi, concat_symbol call incref_object - mov [rdx], BYTE (container_list + content_pointer) - mov [rdx + Cons.car], rsi - - mov rax, rdx - ret - -.splice_unquote_notail: - ; Just return the object in RCX - ; since nothing to concatenate with - mov rax, rcx - ret - -.splice_unquote_empty: - ; Nothing in the (splice-unquote) list, so ignore - ; Just call quasiquote on the rest of RSI - - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .empty_list ; Nothing else - - mov rsi, [rsi + Cons.cdr] - jmp quasiquote ; Tail call - -.empty_list: - ; Return an empty list + ;; rax := ('concat elt acc) call alloc_cons - mov [rax], BYTE maltype_empty_list -.return: + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + ret - +.default: + ;; rax := (accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.car], r9 + + ;; rcx := quasiquoted_element + ;; rdx := (accumulator) + push rax + call quasiquote + mov rcx, rax + pop rdx + + ;; rdx := (quasiquoted_element accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rcx + mov [rax + Cons.cdr], rdx + mov rdx, rax + + mov rsi, cons_symbol + call incref_object + + ;; rax := ('cons quasiquoted_elt accumulator) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + + ;; Tests if an AST in RSI is a list containing ;; a macro defined in the ENV in R15 ;; diff --git a/impls/nasm/stepA_mal.asm b/impls/nasm/stepA_mal.asm index 4fbc1bf3..571f14cd 100644 --- a/impls/nasm/stepA_mal.asm +++ b/impls/nasm/stepA_mal.asm @@ -70,10 +70,12 @@ section .data static_symbol quote_symbol, 'quote' static_symbol quasiquote_symbol, 'quasiquote' + static_symbol quasiquoteexpand_symbol, 'quasiquoteexpand' static_symbol unquote_symbol, 'unquote' static_symbol splice_unquote_symbol, 'splice-unquote' static_symbol concat_symbol, 'concat' static_symbol cons_symbol, 'cons' + static_symbol vec_symbol, 'vec' ;; Startup string. This is evaluated on startup static mal_startup_string, db "(do \ @@ -91,7 +93,29 @@ section .data static mal_startup_header, db "(println (str ",34,"Mal [",34," *host-language* ",34,"]",34,"))" section .text - + + +;;; Extract the car of a Cons and increment its reference count. +;;; If it was value, create a fresh copy. +;;; in : rsi (which must be a pointer!) +;;; out : rsi +;;; modified: : cl, rax, rbx +car_and_incref: + mov cl, BYTE [rsi + Cons.typecar] + and cl, content_mask + + mov rsi, [rsi + Cons.car] + + cmp cl, content_pointer + je incref_object + + call alloc_cons + mov [rax + Cons.typecar], BYTE cl ; masked above + mov [rax + Cons.car], rsi + mov rsi, rax + ret + + ;; ---------------------------------------------- ;; Evaluates a form ;; @@ -660,6 +684,9 @@ eval: eval_cmp_symbol quote_symbol ; quote je .quote_symbol + eval_cmp_symbol quasiquoteexpand_symbol + je .quasiquoteexpand_symbol + eval_cmp_symbol quasiquote_symbol ; quasiquote je .quasiquote_symbol @@ -1440,6 +1467,20 @@ eval: jmp .return ; ----------------------------- + +;;; Like quasiquote, but do not evaluate the result. +.quasiquoteexpand_symbol: + ;; Return nil if no cdr + mov cl, BYTE [rsi + Cons.typecdr] + cmp cl, content_pointer + jne .return_nil + + mov rsi, [rsi + Cons.cdr] + call car_and_incref + call quasiquote + jmp .return + + ; ----------------------------- .quasiquote_symbol: ; call quasiquote function with first argument @@ -1910,363 +1951,254 @@ apply_fn: ; The new environment (in RDI) will be released by eval -;; Set ZF if RSI is a non-empty list or vector -;; Modifies RAX, does not modify RSI -is_pair: - mov al, BYTE [rsi] - test al, block_mask - jnz .false ; Not a Cons - cmp al, maltype_empty_list - je .false ; Empty list - cmp al, maltype_empty_vector - je .false ; Empty vector - - ; Something non empty - and al, container_mask - cmp al, container_list - je .true - cmp al, container_vector - je .true - ; Not a list or vector -> false - -.false: - lahf ; flags in AH - and ah, 255-64 ; clear zero flag - sahf - ret -.true: - lahf ; flags in AH - or ah, 64 ; set zero flag - sahf - ret - -;; Called by eval with AST in RSI [ modified ] -;; Returns new AST in RAX +;;; Called by eval +;;; Original AST in RSI. +;;; Returns new AST in RAX quasiquote: - ; i. Check if AST is an empty list - call is_pair - jne .quote_ast - - ; ii. Check if the first element of RSI is the symbol - ; 'unquote' - - mov al, BYTE [rsi] - and al, content_mask - cmp al, content_pointer - jne .not_unquote ; Not a pointer - - mov rdi, [rsi + Cons.car] ; Get the pointer - mov cl, BYTE [rdi] - cmp cl, maltype_symbol - jne .not_unquote - - ; Compare against 'unquote' - mov r8, rsi - mov r9, rax - - mov rsi, unquote_symbol - call compare_char_array - test rax, rax - - mov rax, r9 - mov rsi, r8 - - je .unquote - -.not_unquote: - ; iii. Handle splice-unquote - ; RSI -> ( ( splice-unquote ? ) ? ) - - ; Test if RSI contains a pointer - - cmp al, content_pointer - jne .not_splice - - mov rbx, [rsi + Cons.car] ; Get the object pointer - - ; RBX -> ( splice-unquote ? ) - - xchg rbx, rsi - call is_pair - xchg rbx, rsi - jne .not_splice ; First element not a pair - - ; Check if this list in RBX starts with 'splice-unquote' symbol - mov al, BYTE [rbx] - and al, content_mask - cmp al, content_pointer - jne .not_splice - - - mov rdi, [rbx + Cons.car] ; Get the pointer - mov al, BYTE [rdi] - cmp al, maltype_symbol - jne .not_splice - - mov r8, rsi - mov r9, rbx - - ; Compare against 'splice-unquote' - mov rsi, splice_unquote_symbol - call compare_char_array - test rax, rax - - mov rbx, r9 - mov rsi, r8 - - je .splice_unquote - -.not_splice: - - ; iv. Cons first and rest of AST in RSI - - ; check if pointer or value - mov cl, BYTE [rsi] - and cl, content_mask - cmp cl, content_pointer - je .cons_pointer - - ; a value, so copy - call alloc_cons - or cl, container_list - mov [rax], BYTE cl ; List + Content - mov rbx, [rsi + Cons.car] - mov [rax + Cons.car], rbx - mov rcx, rax - jmp .cons_first - -.cons_pointer: - ; Get the pointer and call quasiquote - push rsi - mov rsi, [rsi + Cons.car] - call quasiquote - mov rcx, rax - pop rsi - - call alloc_cons - mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rcx - mov rcx, rax - -.cons_first: - ; Have Cons with first object in RCX - - ; Call quasiquote on the rest of the AST - ; Check if this is the end of the list - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .cons_ast_end - - mov rsi, [rsi + Cons.cdr] ; Rest of the list - - call incref_object ; Will release after quasiquote call - - jmp .cons_quasiquote_ast - -.cons_ast_end: - ; End of the AST, so make an empty list - call alloc_cons - mov [rax], BYTE maltype_empty_list - mov rsi, rax - -.cons_quasiquote_ast: - push rcx - push rsi - call quasiquote - mov rdx, rax ; List in RDX - - pop rsi - call release_object ; Release input - - pop rcx ; Value in RCX - - ; cons RCX and RDX - ; Work from the end of the list to the front - - call alloc_cons - mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rdx ; The rest of AST - - ; Link to the RCX Cons - mov [rcx + Cons.typecdr], BYTE content_pointer - mov [rcx + Cons.cdr], rax - mov rdx, rcx - - call alloc_cons ; Cons for cons symbol - mov [rax + Cons.typecdr], BYTE content_pointer - mov [rax + Cons.cdr], rdx - mov rdx, rax - - ; Get the cons symbol - mov rsi, cons_symbol - call incref_object - - mov [rdx], BYTE (container_list + content_pointer) - mov [rdx + Cons.car], rsi - - mov rax, rdx - ret - -.quote_ast: - ; Return (quote RSI) - - call incref_object ; RSI reference count - - ; Cons for RSI - call alloc_cons - mov [rax], BYTE (block_cons + container_list + content_pointer) - mov [rax + Cons.car], rsi - mov rsi, rax - - ; Cons for quote symbol - call alloc_cons - mov rbx, rax - mov [rbx + Cons.typecdr], BYTE content_pointer - mov [rbx + Cons.cdr], rsi - - ; Get a quote symbol, incrementing references - mov rsi, quote_symbol - call incref_object - - ; Put into the Cons in RBX - mov [rbx + Cons.car], rsi - mov [rbx], BYTE (block_cons + container_list + content_pointer) - mov rax, rbx - ret - ; ----------------------- - -.unquote: - - ; Got unquote symbol. Return second element of RSI - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .empty_list ; No second element - - mov rsi, [rsi + Cons.cdr] - - ; Check if it's a value or pointer - mov cl, BYTE [rsi] - and cl, content_mask - cmp cl, content_pointer - je .unquote_pointer - - ; A value, so need a new Cons - call alloc_cons - mov [rax], BYTE cl ; content - mov rbx, [rsi + Cons.car] - mov [rax + Cons.car], rbx ; Copy content - ret - -.unquote_pointer: - mov rsi, [rsi + Cons.car] + ;; Dispatch on the type. + mov al, BYTE [rsi + Cons.typecar] + mov cl, al ; keep full al for .list + and cl, container_mask + cmp cl, container_list + je .list + cmp cl, container_map + je .map + cmp cl, container_symbol + je .symbol + cmp cl, container_vector + je .vector + ;; return other types unchanged call incref_object mov rax, rsi ret - ; ----------------------- -.splice_unquote: - ; RSI -> ( RBX->( splice-unquote A ) B ) - ; - ; RBX Car points to splice-unquote symbol +.list: + ;; AST is a list, process it with qq_foldr unless.. + mov cl, al ; it is not empty, + and cl, content_mask + cmp cl, content_empty + je qq_foldr - ; Check if there is anything after the symbol - mov al, BYTE [rbx + Cons.typecdr] - cmp al, content_pointer - jne .splice_unquote_empty + cmp cl, content_pointer ; and it is a pointer, + jne qq_foldr - ; Point to the second element of the splice-unquote list - mov rcx, [rbx + Cons.cdr] - - ; Check whether it's a value or pointer - mov al, BYTE [rcx] - and al, content_mask - cmp al, content_pointer - je .splice_unquote_pointer + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne qq_foldr - ; A value, so change the container to a value - mov [rcx], BYTE al - ; Remove pointer from RBX - mov [rbx + Cons.typecdr], BYTE 0 - jmp .splice_unquote_first ; Got the value in RCX - -.splice_unquote_pointer: - mov rcx, [rcx + Cons.car] ; Get the object pointed to - xchg rcx, rsi - call incref_object - xchg rcx, rsi ; Object in RCX - -.splice_unquote_first: ; Got the first object in RCX + mov r8, rsi ; and the symbol is 'unquote, + mov rsi, unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne qq_foldr - ; Check if RSI contains anything else - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .splice_unquote_notail + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne qq_foldr + ;; If so, return the argument. mov rsi, [rsi + Cons.cdr] - - ; Now have: - ; ( ( splice-unquote A ) B ) - ; RCX->A RSI->( B ) - ; Need to call quasiquote on the rest of the list - push rcx - call quasiquote - mov rdx, rax - pop rcx - ; Need to concat rcx and rdx - ; Work from the end of the list to the front - - call alloc_cons - mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rdx ; The rest of AST - mov rdx, rax ; Push list into RDX + call car_and_incref + mov rax, rsi + ret +.map: +.symbol: + call incref_object + + ;; rdx := (ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rsi + mov rdx, rax + + mov rsi, quote_symbol + call incref_object + + ;; rax := ('quote ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + +.vector: + ;; rdx := ast processed like a list + call qq_foldr + mov rdx, rax + + ;; rdx := (processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.car], rdx + mov rdx, rax + + mov rsi, vec_symbol + call incref_object + + ;; rax := ('vec processed_ast) + call alloc_cons + mov [rax + Cons.typecar], BYTE (block_cons + container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + + +;;; Helper for quasiquote. +;;; RSI must contain a list or vector, which may be empty. +;;; The result in RAX is always a list. +;;; Iterate on the elements in the right fold/reduce style. +qq_foldr: + mov cl, BYTE [rsi + Cons.typecar] + + cmp cl, maltype_empty_list + je .empty_list + + cmp cl, maltype_empty_vector + je .empty_vector + + ;; Extract first element and store it into the stack during + ;; the recursion. + mov rdx, rsi + call car_and_incref + push rsi + mov rsi, rdx + + ;; Extract the rest of the list. + mov al, BYTE [rsi + Cons.typecdr] + +;;; If the rest is not empty + cmp al, content_pointer + jne .else +;;; then + mov rsi, [rsi + Cons.cdr] + jmp .endif +.else: + call alloc_cons + mov [rax], BYTE maltype_empty_list + mov rsi, rax +.endif: + call qq_foldr ; recursive call + pop rsi + jmp qq_loop + +.empty_list: ;; () -> () + call incref_object + mov rax, rsi + ret + +.empty_vector: ;; [] -> () + call alloc_cons + mov [rax], BYTE maltype_empty_list + ret + + +;; Helper for quasiquote +;; The transition function starts here. +;; Current element is in rsi, accumulator in rax. +qq_loop: + mov r9, rax + + ;; Process with the element with .default, unless.. + mov cl, BYTE [rsi + Cons.typecar] ; it is a list + mov al, cl + and al, container_mask + cmp al, container_list + jne .default + + cmp cl, maltype_empty_list ; it is not empty, + je .default + + and cl, content_mask ; and it is a pointer, + cmp cl, content_pointer + jne .default + + mov rdi, [rsi + Cons.car] ; and the first element is a symbol, + mov cl, BYTE [rdi + Cons.typecar] + cmp cl, maltype_symbol + jne .default + + mov r8, rsi ; and the symbol is 'splice-unquote, + mov rsi, splice_unquote_symbol + call compare_char_array + test rax, rax + mov rsi, r8 + jne .default + + mov cl, BYTE [rsi + Cons.typecdr] ; and there is a second element. + cmp cl, content_pointer + jne .default + + ;; If so, return ('concat elt acc). + mov rsi, [rsi + Cons.cdr] + call car_and_incref + + ;; rdx := (acc) call alloc_cons mov [rax], BYTE (container_list + content_pointer) - mov [rax + Cons.car], rcx ; The splice-unquote object - mov [rax + Cons.typecdr], BYTE content_pointer - mov [rax + Cons.cdr], rdx + mov [rax + Cons.car], r9 mov rdx, rax - - call alloc_cons ; Cons for concat symbol + + ;; rdx := (elt acc) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi mov [rax + Cons.cdr], rdx mov rdx, rax - ; Get the concat symbol mov rsi, concat_symbol call incref_object - mov [rdx], BYTE (container_list + content_pointer) - mov [rdx + Cons.car], rsi - - mov rax, rdx - ret - -.splice_unquote_notail: - ; Just return the object in RCX - ; since nothing to concatenate with - mov rax, rcx - ret - -.splice_unquote_empty: - ; Nothing in the (splice-unquote) list, so ignore - ; Just call quasiquote on the rest of RSI - - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .empty_list ; Nothing else - - mov rsi, [rsi + Cons.cdr] - jmp quasiquote ; Tail call - -.empty_list: - ; Return an empty list + ;; rax := ('concat elt acc) call alloc_cons - mov [rax], BYTE maltype_empty_list -.return: + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + ret - +.default: + ;; rax := (accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.car], r9 + + ;; rcx := quasiquoted_element + ;; rdx := (accumulator) + push rax + call quasiquote + mov rcx, rax + pop rdx + + ;; rdx := (quasiquoted_element accumulator) + call alloc_cons + mov [rax + Cons.typecar], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rcx + mov [rax + Cons.cdr], rdx + mov rdx, rax + + mov rsi, cons_symbol + call incref_object + + ;; rax := ('cons quasiquoted_elt accumulator) + call alloc_cons + mov [rax], BYTE (container_list + content_pointer) + mov [rax + Cons.typecdr], BYTE content_pointer + mov [rax + Cons.car], rsi + mov [rax + Cons.cdr], rdx + + ret + + ;; Tests if an AST in RSI is a list containing ;; a macro defined in the ENV in R15 ;; diff --git a/impls/nim/core.nim b/impls/nim/core.nim index e3acf010..37f37034 100644 --- a/impls/nim/core.nim +++ b/impls/nim/core.nim @@ -37,6 +37,11 @@ proc concat(xs: varargs[MalType]): MalType = for i in x.list: result.list.add i +proc vec(xs: varargs[MalType]): MalType = + result = MalType(kind: Vector, list: newSeq[MalType](xs[0].list.len)) + for i, x in xs[0].list: + result.list[i] = x + proc nth(xs: varargs[MalType]): MalType = if xs[1].number < xs[0].list.len: return xs[0].list[xs[1].number] else: raise newException(ValueError, "nth: index out of range") @@ -204,6 +209,7 @@ let ns* = { "sequential?": fun seq_q, "cons": fun cons, "concat": fun concat, + "vec": fun vec, "count": fun count, "nth": fun nth, "first": fun first, diff --git a/impls/nim/step7_quote.nim b/impls/nim/step7_quote.nim index 0c534bcb..528a0c47 100644 --- a/impls/nim/step7_quote.nim +++ b/impls/nim/step7_quote.nim @@ -2,19 +2,32 @@ import rdstdin, tables, sequtils, os, types, reader, printer, env, core proc read(str: string): MalType = str.read_str -proc is_pair(x: MalType): bool = - x.kind in {List, Vector} and x.list.len > 0 +proc quasiquote(ast: MalType): MalType + +proc quasiquote_loop(xs: seq[MalType]): MalType = + result = list() + for i in countdown(xs.high, 0): + var elt = xs[i] + if elt.kind == List and 0 < elt.list.len and elt.list[0] == symbol "splice-unquote": + result = list(symbol "concat", elt.list[1], result) + else: + result = list(symbol "cons", quasiquote(elt), result) proc quasiquote(ast: MalType): MalType = - if not ast.is_pair: - return list(symbol "quote", ast) - elif ast.list[0] == symbol "unquote": - return ast.list[1] - elif ast.list[0].is_pair and ast.list[0].list[0] == symbol "splice-unquote": - return list(symbol "concat", ast.list[0].list[1], - quasiquote(list ast.list[1 .. ^1])) + case ast.kind + of List: + if ast.list.len == 2 and ast.list[0] == symbol "unquote": + result = ast.list[1] + else: + result = quasiquote_loop(ast.list) + of Vector: + result = list(symbol "vec", quasiquote_loop(ast.list)) + of Symbol: + result = list(symbol "quote", ast) + of HashMap: + result = list(symbol "quote", ast) else: - return list(symbol "cons", quasiquote(ast.list[0]), quasiquote(list(ast.list[1 .. ^1]))) + result = ast proc eval(ast: MalType, env: Env): MalType @@ -78,6 +91,9 @@ proc eval(ast: MalType, env: Env): MalType = of "quote": return ast.list[1] + of "quasiquoteexpand": + return ast.list[1].quasiquote + of "quasiquote": ast = ast.list[1].quasiquote # Continue loop (TCO) diff --git a/impls/nim/step8_macros.nim b/impls/nim/step8_macros.nim index 5b3fa2d0..1db46b4a 100644 --- a/impls/nim/step8_macros.nim +++ b/impls/nim/step8_macros.nim @@ -2,19 +2,32 @@ import rdstdin, tables, sequtils, os, types, reader, printer, env, core proc read(str: string): MalType = str.read_str -proc is_pair(x: MalType): bool = - x.kind in {List, Vector} and x.list.len > 0 +proc quasiquote(ast: MalType): MalType + +proc quasiquote_loop(xs: seq[MalType]): MalType = + result = list() + for i in countdown(xs.high, 0): + var elt = xs[i] + if elt.kind == List and 0 < elt.list.len and elt.list[0] == symbol "splice-unquote": + result = list(symbol "concat", elt.list[1], result) + else: + result = list(symbol "cons", quasiquote(elt), result) proc quasiquote(ast: MalType): MalType = - if not ast.is_pair: - return list(symbol "quote", ast) - elif ast.list[0] == symbol "unquote": - return ast.list[1] - elif ast.list[0].is_pair and ast.list[0].list[0] == symbol "splice-unquote": - return list(symbol "concat", ast.list[0].list[1], - quasiquote(list ast.list[1 .. ^1])) + case ast.kind + of List: + if ast.list.len == 2 and ast.list[0] == symbol "unquote": + result = ast.list[1] + else: + result = quasiquote_loop(ast.list) + of Vector: + result = list(symbol "vec", quasiquote_loop(ast.list)) + of Symbol: + result = list(symbol "quote", ast) + of HashMap: + result = list(symbol "quote", ast) else: - return list(symbol "cons", quasiquote(ast.list[0]), quasiquote(list(ast.list[1 .. ^1]))) + result = ast proc is_macro_call(ast: MalType, env: Env): bool = ast.kind == List and ast.list.len > 0 and ast.list[0].kind == Symbol and @@ -91,6 +104,9 @@ proc eval(ast: MalType, env: Env): MalType = of "quote": return ast.list[1] + of "quasiquoteexpand": + return ast.list[1].quasiquote + of "quasiquote": ast = ast.list[1].quasiquote # Continue loop (TCO) diff --git a/impls/nim/step9_try.nim b/impls/nim/step9_try.nim index 11159bea..e345f296 100644 --- a/impls/nim/step9_try.nim +++ b/impls/nim/step9_try.nim @@ -2,19 +2,32 @@ import rdstdin, tables, sequtils, os, types, reader, printer, env, core proc read(str: string): MalType = str.read_str -proc is_pair(x: MalType): bool = - x.kind in {List, Vector} and x.list.len > 0 +proc quasiquote(ast: MalType): MalType + +proc quasiquote_loop(xs: seq[MalType]): MalType = + result = list() + for i in countdown(xs.high, 0): + var elt = xs[i] + if elt.kind == List and 0 < elt.list.len and elt.list[0] == symbol "splice-unquote": + result = list(symbol "concat", elt.list[1], result) + else: + result = list(symbol "cons", quasiquote(elt), result) proc quasiquote(ast: MalType): MalType = - if not ast.is_pair: - return list(symbol "quote", ast) - elif ast.list[0] == symbol "unquote": - return ast.list[1] - elif ast.list[0].is_pair and ast.list[0].list[0] == symbol "splice-unquote": - return list(symbol "concat", ast.list[0].list[1], - quasiquote(list ast.list[1 .. ^1])) + case ast.kind + of List: + if ast.list.len == 2 and ast.list[0] == symbol "unquote": + result = ast.list[1] + else: + result = quasiquote_loop(ast.list) + of Vector: + result = list(symbol "vec", quasiquote_loop(ast.list)) + of Symbol: + result = list(symbol "quote", ast) + of HashMap: + result = list(symbol "quote", ast) else: - return list(symbol "cons", quasiquote(ast.list[0]), quasiquote(list(ast.list[1 .. ^1]))) + result = ast proc is_macro_call(ast: MalType, env: Env): bool = ast.kind == List and ast.list.len > 0 and ast.list[0].kind == Symbol and @@ -92,6 +105,9 @@ proc eval(ast: MalType, env: Env): MalType = of "quote": return ast.list[1] + of "quasiquoteexpand": + return ast.list[1].quasiquote + of "quasiquote": ast = ast.list[1].quasiquote # Continue loop (TCO) diff --git a/impls/nim/stepA_mal.nim b/impls/nim/stepA_mal.nim index ac487a5f..509422ca 100644 --- a/impls/nim/stepA_mal.nim +++ b/impls/nim/stepA_mal.nim @@ -2,19 +2,32 @@ import rdstdin, tables, sequtils, os, types, reader, printer, env, core proc read(str: string): MalType = str.read_str -proc is_pair(x: MalType): bool = - x.kind in {List, Vector} and x.list.len > 0 +proc quasiquote(ast: MalType): MalType + +proc quasiquote_loop(xs: seq[MalType]): MalType = + result = list() + for i in countdown(xs.high, 0): + var elt = xs[i] + if elt.kind == List and 0 < elt.list.len and elt.list[0] == symbol "splice-unquote": + result = list(symbol "concat", elt.list[1], result) + else: + result = list(symbol "cons", quasiquote(elt), result) proc quasiquote(ast: MalType): MalType = - if not ast.is_pair: - return list(symbol "quote", ast) - elif ast.list[0] == symbol "unquote": - return ast.list[1] - elif ast.list[0].is_pair and ast.list[0].list[0] == symbol "splice-unquote": - return list(symbol "concat", ast.list[0].list[1], - quasiquote(list ast.list[1 .. ^1])) + case ast.kind + of List: + if ast.list.len == 2 and ast.list[0] == symbol "unquote": + result = ast.list[1] + else: + result = quasiquote_loop(ast.list) + of Vector: + result = list(symbol "vec", quasiquote_loop(ast.list)) + of Symbol: + result = list(symbol "quote", ast) + of HashMap: + result = list(symbol "quote", ast) else: - return list(symbol "cons", quasiquote(ast.list[0]), quasiquote(list(ast.list[1 .. ^1]))) + result = ast proc is_macro_call(ast: MalType, env: Env): bool = ast.kind == List and ast.list.len > 0 and ast.list[0].kind == Symbol and @@ -92,6 +105,9 @@ proc eval(ast: MalType, env: Env): MalType = of "quote": return ast.list[1] + of "quasiquoteexpand": + return ast.list[1].quasiquote + of "quasiquote": ast = ast.list[1].quasiquote # Continue loop (TCO) diff --git a/impls/objc/Dockerfile b/impls/objc/Dockerfile index fa7e3a4f..fa7e6788 100644 --- a/impls/objc/Dockerfile +++ b/impls/objc/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +M ubuntu:vivid MAINTAINER Joel Martin ########################################################## diff --git a/impls/objc/core.m b/impls/objc/core.m index 3a77d0db..913b42f8 100644 --- a/impls/objc/core.m +++ b/impls/objc/core.m @@ -201,6 +201,9 @@ NSObject * wrap_tf(BOOL val) { } return res; }, + @"vec": ^(NSArray *args){ + return [MalVector fromArray:args[0]]; + }, @"nth": ^(NSArray *args){ NSArray * lst = (NSArray *)args[0]; int idx = [(NSNumber *)args[1] intValue]; diff --git a/impls/objc/step7_quote.m b/impls/objc/step7_quote.m index d2b04eb3..56bf78ba 100644 --- a/impls/objc/step7_quote.m +++ b/impls/objc/step7_quote.m @@ -14,34 +14,40 @@ NSObject *READ(NSString *str) { } // eval -BOOL is_pair(NSObject *obj) { - return [obj isKindOfClass:[NSArray class]] && - [(NSArray *)obj count] > 0; +BOOL starts_with(NSObject *ast, NSString *sym) { + if (!list_Q(ast)) + return 0; + NSArray *alst = (NSArray *)ast; + if (![alst count]) + return 0; + NSObject *a0 = alst[0]; + return [a0 isKindOfClass:[MalSymbol class]] && + [(NSString *)a0 isEqualTo:sym]; } NSObject * quasiquote(NSObject *ast) { - if (!is_pair(ast)) { + if ([ast isMemberOfClass:[MalSymbol class]] || + [ast isKindOfClass:[NSDictionary class]]) return @[[MalSymbol stringWithString:@"quote"], ast]; - } else { - NSArray * alst = (NSArray *)ast; - id a0 = alst[0]; - if ([a0 isKindOfClass:[MalSymbol class]] && - [(NSString *)a0 isEqualTo:@"unquote"]) { - return alst[1]; - } else if (is_pair(a0)) { - id a0lst = (NSArray *)a0; - id a00 = a0lst[0]; - if ([a00 isKindOfClass:[MalSymbol class]] && - [(NSString *)a00 isEqualTo:@"splice-unquote"]) { - return @[[MalSymbol stringWithString:@"concat"], - a0lst[1], - quasiquote(_rest(alst))]; - } - } - return @[[MalSymbol stringWithString:@"cons"], - quasiquote(a0), - quasiquote(_rest(alst))]; + + if (![ast isKindOfClass:[NSArray class]]) + return ast; + + NSArray * alst = (NSArray *)ast; + if (starts_with(alst, @"unquote")) + return alst[1]; + + NSObject *res = @[]; + for (int i= [alst count] - 1; 0<=i; i--) { + NSObject *elt = alst[i]; + if (starts_with(elt, @"splice-unquote")) + res = @[[MalSymbol stringWithString:@"concat"], ((NSArray *)elt)[1], res]; + else + res = @[[MalSymbol stringWithString:@"cons"], quasiquote(elt), res]; } + if ([ast isKindOfClass:[MalVector class]]) + res = @[[MalSymbol stringWithString:@"vec"], res]; + return res; } NSObject *eval_ast(NSObject *ast, Env *env) { @@ -96,6 +102,8 @@ NSObject *EVAL(NSObject *ast, Env *env) { ast = alst[2]; // TCO } else if ([(NSString *)a0 isEqualTo:@"quote"]) { return alst[1]; + } else if ([(NSString *)a0 isEqualTo:@"quasiquoteexpand"]) { + return quasiquote(alst[1]); } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) { ast = quasiquote(alst[1]); // TCO } else if ([a0sym isEqualTo:@"do"]) { diff --git a/impls/objc/step8_macros.m b/impls/objc/step8_macros.m index 188f01ce..ebc2d380 100644 --- a/impls/objc/step8_macros.m +++ b/impls/objc/step8_macros.m @@ -14,34 +14,40 @@ NSObject *READ(NSString *str) { } // eval -BOOL is_pair(NSObject *obj) { - return [obj isKindOfClass:[NSArray class]] && - [(NSArray *)obj count] > 0; +BOOL starts_with(NSObject *ast, NSString *sym) { + if (!list_Q(ast)) + return 0; + NSArray *alst = (NSArray *)ast; + if (![alst count]) + return 0; + NSObject *a0 = alst[0]; + return [a0 isKindOfClass:[MalSymbol class]] && + [(NSString *)a0 isEqualTo:sym]; } NSObject * quasiquote(NSObject *ast) { - if (!is_pair(ast)) { + if ([ast isMemberOfClass:[MalSymbol class]] || + [ast isKindOfClass:[NSDictionary class]]) return @[[MalSymbol stringWithString:@"quote"], ast]; - } else { - NSArray * alst = (NSArray *)ast; - id a0 = alst[0]; - if ([a0 isKindOfClass:[MalSymbol class]] && - [(NSString *)a0 isEqualTo:@"unquote"]) { - return alst[1]; - } else if (is_pair(a0)) { - id a0lst = (NSArray *)a0; - id a00 = a0lst[0]; - if ([a00 isKindOfClass:[MalSymbol class]] && - [(NSString *)a00 isEqualTo:@"splice-unquote"]) { - return @[[MalSymbol stringWithString:@"concat"], - a0lst[1], - quasiquote(_rest(alst))]; - } - } - return @[[MalSymbol stringWithString:@"cons"], - quasiquote(a0), - quasiquote(_rest(alst))]; + + if (![ast isKindOfClass:[NSArray class]]) + return ast; + + NSArray * alst = (NSArray *)ast; + if (starts_with(alst, @"unquote")) + return alst[1]; + + NSObject *res = @[]; + for (int i= [alst count] - 1; 0<=i; i--) { + NSObject *elt = alst[i]; + if (starts_with(elt, @"splice-unquote")) + res = @[[MalSymbol stringWithString:@"concat"], ((NSArray *)elt)[1], res]; + else + res = @[[MalSymbol stringWithString:@"cons"], quasiquote(elt), res]; } + if ([ast isKindOfClass:[MalVector class]]) + res = @[[MalSymbol stringWithString:@"vec"], res]; + return res; } BOOL is_macro_call(NSObject *ast, Env *env) { @@ -123,6 +129,8 @@ NSObject *EVAL(NSObject *ast, Env *env) { ast = alst[2]; // TCO } else if ([(NSString *)a0 isEqualTo:@"quote"]) { return alst[1]; + } else if ([(NSString *)a0 isEqualTo:@"quasiquoteexpand"]) { + return quasiquote(alst[1]); } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) { ast = quasiquote(alst[1]); // TCO } else if ([a0sym isEqualTo:@"defmacro!"]) { diff --git a/impls/objc/step9_try.m b/impls/objc/step9_try.m index 45c9c92a..a50d1f58 100644 --- a/impls/objc/step9_try.m +++ b/impls/objc/step9_try.m @@ -14,34 +14,40 @@ NSObject *READ(NSString *str) { } // eval -BOOL is_pair(NSObject *obj) { - return [obj isKindOfClass:[NSArray class]] && - [(NSArray *)obj count] > 0; +BOOL starts_with(NSObject *ast, NSString *sym) { + if (!list_Q(ast)) + return 0; + NSArray *alst = (NSArray *)ast; + if (![alst count]) + return 0; + NSObject *a0 = alst[0]; + return [a0 isKindOfClass:[MalSymbol class]] && + [(NSString *)a0 isEqualTo:sym]; } NSObject * quasiquote(NSObject *ast) { - if (!is_pair(ast)) { + if ([ast isMemberOfClass:[MalSymbol class]] || + [ast isKindOfClass:[NSDictionary class]]) return @[[MalSymbol stringWithString:@"quote"], ast]; - } else { - NSArray * alst = (NSArray *)ast; - id a0 = alst[0]; - if ([a0 isKindOfClass:[MalSymbol class]] && - [(NSString *)a0 isEqualTo:@"unquote"]) { - return alst[1]; - } else if (is_pair(a0)) { - id a0lst = (NSArray *)a0; - id a00 = a0lst[0]; - if ([a00 isKindOfClass:[MalSymbol class]] && - [(NSString *)a00 isEqualTo:@"splice-unquote"]) { - return @[[MalSymbol stringWithString:@"concat"], - a0lst[1], - quasiquote(_rest(alst))]; - } - } - return @[[MalSymbol stringWithString:@"cons"], - quasiquote(a0), - quasiquote(_rest(alst))]; + + if (![ast isKindOfClass:[NSArray class]]) + return ast; + + NSArray * alst = (NSArray *)ast; + if (starts_with(alst, @"unquote")) + return alst[1]; + + NSObject *res = @[]; + for (int i= [alst count] - 1; 0<=i; i--) { + NSObject *elt = alst[i]; + if (starts_with(elt, @"splice-unquote")) + res = @[[MalSymbol stringWithString:@"concat"], ((NSArray *)elt)[1], res]; + else + res = @[[MalSymbol stringWithString:@"cons"], quasiquote(elt), res]; } + if ([ast isKindOfClass:[MalVector class]]) + res = @[[MalSymbol stringWithString:@"vec"], res]; + return res; } BOOL is_macro_call(NSObject *ast, Env *env) { @@ -123,6 +129,8 @@ NSObject *EVAL(NSObject *ast, Env *env) { ast = alst[2]; // TCO } else if ([(NSString *)a0 isEqualTo:@"quote"]) { return alst[1]; + } else if ([(NSString *)a0 isEqualTo:@"quasiquoteexpand"]) { + return quasiquote(alst[1]); } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) { ast = quasiquote(alst[1]); // TCO } else if ([a0sym isEqualTo:@"defmacro!"]) { diff --git a/impls/objc/stepA_mal.m b/impls/objc/stepA_mal.m index 4727e4f0..7004395e 100644 --- a/impls/objc/stepA_mal.m +++ b/impls/objc/stepA_mal.m @@ -14,34 +14,40 @@ NSObject *READ(NSString *str) { } // eval -BOOL is_pair(NSObject *obj) { - return [obj isKindOfClass:[NSArray class]] && - [(NSArray *)obj count] > 0; +BOOL starts_with(NSObject *ast, NSString *sym) { + if (!list_Q(ast)) + return 0; + NSArray *alst = (NSArray *)ast; + if (![alst count]) + return 0; + NSObject *a0 = alst[0]; + return [a0 isKindOfClass:[MalSymbol class]] && + [(NSString *)a0 isEqualTo:sym]; } NSObject * quasiquote(NSObject *ast) { - if (!is_pair(ast)) { + if ([ast isMemberOfClass:[MalSymbol class]] || + [ast isKindOfClass:[NSDictionary class]]) return @[[MalSymbol stringWithString:@"quote"], ast]; - } else { - NSArray * alst = (NSArray *)ast; - id a0 = alst[0]; - if ([a0 isKindOfClass:[MalSymbol class]] && - [(NSString *)a0 isEqualTo:@"unquote"]) { - return alst[1]; - } else if (is_pair(a0)) { - id a0lst = (NSArray *)a0; - id a00 = a0lst[0]; - if ([a00 isKindOfClass:[MalSymbol class]] && - [(NSString *)a00 isEqualTo:@"splice-unquote"]) { - return @[[MalSymbol stringWithString:@"concat"], - a0lst[1], - quasiquote(_rest(alst))]; - } - } - return @[[MalSymbol stringWithString:@"cons"], - quasiquote(a0), - quasiquote(_rest(alst))]; + + if (![ast isKindOfClass:[NSArray class]]) + return ast; + + NSArray * alst = (NSArray *)ast; + if (starts_with(alst, @"unquote")) + return alst[1]; + + NSObject *res = @[]; + for (int i= [alst count] - 1; 0<=i; i--) { + NSObject *elt = alst[i]; + if (starts_with(elt, @"splice-unquote")) + res = @[[MalSymbol stringWithString:@"concat"], ((NSArray *)elt)[1], res]; + else + res = @[[MalSymbol stringWithString:@"cons"], quasiquote(elt), res]; } + if ([ast isKindOfClass:[MalVector class]]) + res = @[[MalSymbol stringWithString:@"vec"], res]; + return res; } BOOL is_macro_call(NSObject *ast, Env *env) { @@ -123,6 +129,8 @@ NSObject *EVAL(NSObject *ast, Env *env) { ast = alst[2]; // TCO } else if ([(NSString *)a0 isEqualTo:@"quote"]) { return alst[1]; + } else if ([(NSString *)a0 isEqualTo:@"quasiquoteexpand"]) { + return quasiquote(alst[1]); } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) { ast = quasiquote(alst[1]); // TCO } else if ([a0sym isEqualTo:@"defmacro!"]) { diff --git a/impls/objpascal/core.pas b/impls/objpascal/core.pas index 1822d887..d51374c5 100644 --- a/impls/objpascal/core.pas +++ b/impls/objpascal/core.pas @@ -204,6 +204,10 @@ function list_Q(Args: TMalArray) : TMal; begin list_Q := wrap_tf(Args[0].ClassType = TMalList); end; +function vec(Args: TMalArray) : TMal; +begin + vec := TMalVector.Create((Args[0] as TMalList).Val); +end; function vector(Args: TMalArray) : TMal; begin vector := TMalVector.Create(Args); @@ -604,6 +608,7 @@ begin NS['sequential?'] := @sequential_Q; NS['cons'] := @cons; NS['concat'] := @do_concat; + NS['vec'] := @vec; NS['nth'] := @nth; NS['first'] := @first; NS['rest'] := @rest; diff --git a/impls/objpascal/step7_quote.pas b/impls/objpascal/step7_quote.pas index fc583b80..c960b1e5 100644 --- a/impls/objpascal/step7_quote.pas +++ b/impls/objpascal/step7_quote.pas @@ -28,39 +28,47 @@ begin end; // eval -function is_pair(x: TMal) : Boolean; + +function starts_with(Ast: TMal; Sym: String) : Boolean; +var + Arr : TMalArray; + A0 : TMal; begin - is_pair := _sequential_Q(x) and (Length((x as TMalList).Val) > 0); + if Ast.ClassType <> TMalList then Exit (False); + Arr := (Ast as TMalList).Val; + if Length (Arr) = 0 then Exit (False); + A0 := Arr [0]; + starts_with := (A0.ClassType = TMalSymbol) and ((A0 as TMalSymbol).Val = Sym); end; function quasiquote(Ast: TMal) : TMal; var - Arr, Arr0 : TMalArray; - A0, A00 : TMal; + Arr : TMalArray; + Res, Elt : TMal; + I : longint; begin - if not is_pair(Ast) then - Exit(_list(TMalSymbol.Create('quote'), Ast)) - else + if Ast is TMalSymbol or Ast is TMalHashMap then + Exit(_list(TMalSymbol.Create('quote'), Ast)); + + if not (Ast is TMalList) then + Exit(Ast); + + Arr := (Ast as TMalList).Val; + if starts_with (Ast, 'unquote') then Exit(Arr[1]); + + Res := _list(); + for I := 1 to Length(Arr) do begin - Arr := (Ast as TMalList).Val; - A0 := Arr[0]; - if (A0 is TMalSymbol) and - ((A0 as TMalSymbol).Val = 'unquote') then - Exit(Arr[1]) - else if is_pair(A0) then - begin - Arr0 := (Arr[0] as TMalList).Val; - A00 := Arr0[0]; - if (A00 is TMalSymbol) and - ((A00 as TMalSymbol).Val = 'splice-unquote') then - Exit(_list(TMalSymbol.Create('concat'), - Arr0[1], - quasiquote((Ast as TMalList).Rest))); - end; - quasiquote := _list(TMalSymbol.Create('cons'), - quasiquote(A0), - quasiquote((Ast as TMalList).Rest)); + Elt := Arr [Length(Arr) - I]; + if starts_with (Elt, 'splice-unquote') then + Res := _list(TMalSymbol.Create('concat'), (Elt as TMalList).Val[1], Res) + else + Res := _list(TMalSymbol.Create('cons'), quasiquote (Elt), Res); end; + if Ast.ClassType <> TMalList then + Exit(_list(TMalSymbol.Create('vec'), Res)) + else + Exit(Res); end; @@ -152,6 +160,8 @@ begin end; 'quote': Exit(Arr[1]); + 'quasiquoteexpand': + Exit(quasiquote(Arr[1])); 'quasiquote': Ast := quasiquote(Arr[1]); 'do': diff --git a/impls/objpascal/step8_macros.pas b/impls/objpascal/step8_macros.pas index 541f2674..a0be0bda 100644 --- a/impls/objpascal/step8_macros.pas +++ b/impls/objpascal/step8_macros.pas @@ -28,39 +28,47 @@ begin end; // eval -function is_pair(x: TMal) : Boolean; + +function starts_with(Ast: TMal; Sym: String) : Boolean; +var + Arr : TMalArray; + A0 : TMal; begin - is_pair := _sequential_Q(x) and (Length((x as TMalList).Val) > 0); + if Ast.ClassType <> TMalList then Exit (False); + Arr := (Ast as TMalList).Val; + if Length (Arr) = 0 then Exit (False); + A0 := Arr [0]; + starts_with := (A0.ClassType = TMalSymbol) and ((A0 as TMalSymbol).Val = Sym); end; function quasiquote(Ast: TMal) : TMal; var - Arr, Arr0 : TMalArray; - A0, A00 : TMal; + Arr : TMalArray; + Res, Elt : TMal; + I : longint; begin - if not is_pair(Ast) then - Exit(_list(TMalSymbol.Create('quote'), Ast)) - else + if Ast is TMalSymbol or Ast is TMalHashMap then + Exit(_list(TMalSymbol.Create('quote'), Ast)); + + if not (Ast is TMalList) then + Exit(Ast); + + Arr := (Ast as TMalList).Val; + if starts_with (Ast, 'unquote') then Exit(Arr[1]); + + Res := _list(); + for I := 1 to Length(Arr) do begin - Arr := (Ast as TMalList).Val; - A0 := Arr[0]; - if (A0 is TMalSymbol) and - ((A0 as TMalSymbol).Val = 'unquote') then - Exit(Arr[1]) - else if is_pair(A0) then - begin - Arr0 := (Arr[0] as TMalList).Val; - A00 := Arr0[0]; - if (A00 is TMalSymbol) and - ((A00 as TMalSymbol).Val = 'splice-unquote') then - Exit(_list(TMalSymbol.Create('concat'), - Arr0[1], - quasiquote((Ast as TMalList).Rest))); - end; - quasiquote := _list(TMalSymbol.Create('cons'), - quasiquote(A0), - quasiquote((Ast as TMalList).Rest)); + Elt := Arr [Length(Arr) - I]; + if starts_with (Elt, 'splice-unquote') then + Res := _list(TMalSymbol.Create('concat'), (Elt as TMalList).Val[1], Res) + else + Res := _list(TMalSymbol.Create('cons'), quasiquote (Elt), Res); end; + if Ast.ClassType <> TMalList then + Exit(_list(TMalSymbol.Create('vec'), Res)) + else + Exit(Res); end; function is_macro_call(Ast: TMal; Env: TEnv): Boolean; @@ -197,6 +205,8 @@ begin end; 'quote': Exit(Arr[1]); + 'quasiquoteexpand': + Exit(quasiquote(Arr[1])); 'quasiquote': Ast := quasiquote(Arr[1]); 'defmacro!': diff --git a/impls/objpascal/step9_try.pas b/impls/objpascal/step9_try.pas index 0793afc4..9ee7be4f 100644 --- a/impls/objpascal/step9_try.pas +++ b/impls/objpascal/step9_try.pas @@ -28,39 +28,47 @@ begin end; // eval -function is_pair(x: TMal) : Boolean; + +function starts_with(Ast: TMal; Sym: String) : Boolean; +var + Arr : TMalArray; + A0 : TMal; begin - is_pair := _sequential_Q(x) and (Length((x as TMalList).Val) > 0); + if Ast.ClassType <> TMalList then Exit (False); + Arr := (Ast as TMalList).Val; + if Length (Arr) = 0 then Exit (False); + A0 := Arr [0]; + starts_with := (A0.ClassType = TMalSymbol) and ((A0 as TMalSymbol).Val = Sym); end; function quasiquote(Ast: TMal) : TMal; var - Arr, Arr0 : TMalArray; - A0, A00 : TMal; + Arr : TMalArray; + Res, Elt : TMal; + I : longint; begin - if not is_pair(Ast) then - Exit(_list(TMalSymbol.Create('quote'), Ast)) - else + if Ast is TMalSymbol or Ast is TMalHashMap then + Exit(_list(TMalSymbol.Create('quote'), Ast)); + + if not (Ast is TMalList) then + Exit(Ast); + + Arr := (Ast as TMalList).Val; + if starts_with (Ast, 'unquote') then Exit(Arr[1]); + + Res := _list(); + for I := 1 to Length(Arr) do begin - Arr := (Ast as TMalList).Val; - A0 := Arr[0]; - if (A0 is TMalSymbol) and - ((A0 as TMalSymbol).Val = 'unquote') then - Exit(Arr[1]) - else if is_pair(A0) then - begin - Arr0 := (Arr[0] as TMalList).Val; - A00 := Arr0[0]; - if (A00 is TMalSymbol) and - ((A00 as TMalSymbol).Val = 'splice-unquote') then - Exit(_list(TMalSymbol.Create('concat'), - Arr0[1], - quasiquote((Ast as TMalList).Rest))); - end; - quasiquote := _list(TMalSymbol.Create('cons'), - quasiquote(A0), - quasiquote((Ast as TMalList).Rest)); + Elt := Arr [Length(Arr) - I]; + if starts_with (Elt, 'splice-unquote') then + Res := _list(TMalSymbol.Create('concat'), (Elt as TMalList).Val[1], Res) + else + Res := _list(TMalSymbol.Create('cons'), quasiquote (Elt), Res); end; + if Ast.ClassType <> TMalList then + Exit(_list(TMalSymbol.Create('vec'), Res)) + else + Exit(Res); end; function is_macro_call(Ast: TMal; Env: TEnv): Boolean; @@ -198,6 +206,8 @@ begin end; 'quote': Exit(Arr[1]); + 'quasiquoteexpand': + Exit(quasiquote(Arr[1])); 'quasiquote': Ast := quasiquote(Arr[1]); 'defmacro!': diff --git a/impls/objpascal/stepA_mal.pas b/impls/objpascal/stepA_mal.pas index 94c7363d..1de57f59 100644 --- a/impls/objpascal/stepA_mal.pas +++ b/impls/objpascal/stepA_mal.pas @@ -28,39 +28,47 @@ begin end; // eval -function is_pair(x: TMal) : Boolean; + +function starts_with(Ast: TMal; Sym: String) : Boolean; +var + Arr : TMalArray; + A0 : TMal; begin - is_pair := _sequential_Q(x) and (Length((x as TMalList).Val) > 0); + if Ast.ClassType <> TMalList then Exit (False); + Arr := (Ast as TMalList).Val; + if Length (Arr) = 0 then Exit (False); + A0 := Arr [0]; + starts_with := (A0.ClassType = TMalSymbol) and ((A0 as TMalSymbol).Val = Sym); end; function quasiquote(Ast: TMal) : TMal; var - Arr, Arr0 : TMalArray; - A0, A00 : TMal; + Arr : TMalArray; + Res, Elt : TMal; + I : longint; begin - if not is_pair(Ast) then - Exit(_list(TMalSymbol.Create('quote'), Ast)) - else + if Ast is TMalSymbol or Ast is TMalHashMap then + Exit(_list(TMalSymbol.Create('quote'), Ast)); + + if not (Ast is TMalList) then + Exit(Ast); + + Arr := (Ast as TMalList).Val; + if starts_with (Ast, 'unquote') then Exit(Arr[1]); + + Res := _list(); + for I := 1 to Length(Arr) do begin - Arr := (Ast as TMalList).Val; - A0 := Arr[0]; - if (A0 is TMalSymbol) and - ((A0 as TMalSymbol).Val = 'unquote') then - Exit(Arr[1]) - else if is_pair(A0) then - begin - Arr0 := (Arr[0] as TMalList).Val; - A00 := Arr0[0]; - if (A00 is TMalSymbol) and - ((A00 as TMalSymbol).Val = 'splice-unquote') then - Exit(_list(TMalSymbol.Create('concat'), - Arr0[1], - quasiquote((Ast as TMalList).Rest))); - end; - quasiquote := _list(TMalSymbol.Create('cons'), - quasiquote(A0), - quasiquote((Ast as TMalList).Rest)); + Elt := Arr [Length(Arr) - I]; + if starts_with (Elt, 'splice-unquote') then + Res := _list(TMalSymbol.Create('concat'), (Elt as TMalList).Val[1], Res) + else + Res := _list(TMalSymbol.Create('cons'), quasiquote (Elt), Res); end; + if Ast.ClassType <> TMalList then + Exit(_list(TMalSymbol.Create('vec'), Res)) + else + Exit(Res); end; function is_macro_call(Ast: TMal; Env: TEnv): Boolean; @@ -198,6 +206,8 @@ begin end; 'quote': Exit(Arr[1]); + 'quasiquoteexpand': + Exit(quasiquote(Arr[1])); 'quasiquote': Ast := quasiquote(Arr[1]); 'defmacro!': diff --git a/impls/ocaml/Dockerfile b/impls/ocaml/Dockerfile index fbad0fc2..399553db 100644 --- a/impls/ocaml/Dockerfile +++ b/impls/ocaml/Dockerfile @@ -1,4 +1,4 @@ -FROM ubuntu:vivid +[FROM ubuntu:vivid MAINTAINER Joel Martin ########################################################## diff --git a/impls/ocaml/core.ml b/impls/ocaml/core.ml index f733c041..ddc62c1c 100644 --- a/impls/ocaml/core.ml +++ b/impls/ocaml/core.ml @@ -127,6 +127,11 @@ let init env = begin | [x] -> Types.list (seq x) | [] -> Types.list [] in concat)); + Env.set env (Types.symbol "vec") (Types.fn (function + | [T.List {T.value = xs}] -> Types.vector xs + | [T.Vector {T.value = xs}] -> Types.vector xs + | [_] -> raise (Invalid_argument "vec: expects a sequence") + | _ -> raise (Invalid_argument "vec: arg count"))); Env.set env (Types.symbol "nth") (Types.fn (function [xs; T.Int i] -> diff --git a/impls/ocaml/step7_quote.ml b/impls/ocaml/step7_quote.ml index 8598a2df..e1fd16f1 100644 --- a/impls/ocaml/step7_quote.ml +++ b/impls/ocaml/step7_quote.ml @@ -5,14 +5,16 @@ let repl_env = Env.make (Some Core.ns) let rec quasiquote ast = match ast with | T.List { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.Vector { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.List { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } - | T.Vector { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } -> - Types.list [Types.symbol "concat"; head; quasiquote (Types.list tail)] - | T.List { T.value = head :: tail } - | T.Vector { T.value = head :: tail } -> - Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ] - | ast -> Types.list [Types.symbol "quote"; ast] + | T.List {T.value = xs} -> List.fold_right qq_folder xs (Types.list []) + | T.Vector {T.value = xs} -> Types.list [Types.symbol "vec"; + List.fold_right qq_folder xs (Types.list [])] + | T.Map _ -> Types.list [Types.symbol "quote"; ast] + | T.Symbol _ -> Types.list [Types.symbol "quote"; ast] + | _ -> ast +and qq_folder elt acc = + match elt with + | T.List {T.value = [T.Symbol {T.value = "splice-unquote"}; x]} -> Types.list [Types.symbol "concat"; x; acc] + | _ -> Types.list [Types.symbol "cons"; quasiquote elt; acc] let rec eval_ast ast env = match ast with @@ -70,6 +72,8 @@ and eval ast env = in bind_args arg_names args; eval expr sub_env) | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast + | T.List { T.value = [T.Symbol { T.value = "quasiquoteexpand" }; ast] } -> + quasiquote ast | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> eval (quasiquote ast) env | T.List _ -> diff --git a/impls/ocaml/step8_macros.ml b/impls/ocaml/step8_macros.ml index 2bec4e26..eeac9c6d 100644 --- a/impls/ocaml/step8_macros.ml +++ b/impls/ocaml/step8_macros.ml @@ -5,14 +5,16 @@ let repl_env = Env.make (Some Core.ns) let rec quasiquote ast = match ast with | T.List { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.Vector { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.List { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } - | T.Vector { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } -> - Types.list [Types.symbol "concat"; head; quasiquote (Types.list tail)] - | T.List { T.value = head :: tail } - | T.Vector { T.value = head :: tail } -> - Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ] - | ast -> Types.list [Types.symbol "quote"; ast] + | T.List {T.value = xs} -> List.fold_right qq_folder xs (Types.list []) + | T.Vector {T.value = xs} -> Types.list [Types.symbol "vec"; + List.fold_right qq_folder xs (Types.list [])] + | T.Map _ -> Types.list [Types.symbol "quote"; ast] + | T.Symbol _ -> Types.list [Types.symbol "quote"; ast] + | _ -> ast +and qq_folder elt acc = + match elt with + | T.List {T.value = [T.Symbol {T.value = "splice-unquote"}; x]} -> Types.list [Types.symbol "concat"; x; acc] + | _ -> Types.list [Types.symbol "cons"; quasiquote elt; acc] let is_macro_call ast env = match ast with @@ -95,6 +97,8 @@ and eval ast env = in bind_args arg_names args; eval expr sub_env) | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast + | T.List { T.value = [T.Symbol { T.value = "quasiquoteexpand" }; ast] } -> + quasiquote ast | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> eval (quasiquote ast) env | T.List { T.value = [T.Symbol { T.value = "macroexpand" }; ast] } -> diff --git a/impls/ocaml/step9_try.ml b/impls/ocaml/step9_try.ml index f95d8c5a..77a7fc10 100644 --- a/impls/ocaml/step9_try.ml +++ b/impls/ocaml/step9_try.ml @@ -5,14 +5,16 @@ let repl_env = Env.make (Some Core.ns) let rec quasiquote ast = match ast with | T.List { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.Vector { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.List { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } - | T.Vector { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } -> - Types.list [Types.symbol "concat"; head; quasiquote (Types.list tail)] - | T.List { T.value = head :: tail } - | T.Vector { T.value = head :: tail } -> - Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ] - | ast -> Types.list [Types.symbol "quote"; ast] + | T.List {T.value = xs} -> List.fold_right qq_folder xs (Types.list []) + | T.Vector {T.value = xs} -> Types.list [Types.symbol "vec"; + List.fold_right qq_folder xs (Types.list [])] + | T.Map _ -> Types.list [Types.symbol "quote"; ast] + | T.Symbol _ -> Types.list [Types.symbol "quote"; ast] + | _ -> ast +and qq_folder elt acc = + match elt with + | T.List {T.value = [T.Symbol {T.value = "splice-unquote"}; x]} -> Types.list [Types.symbol "concat"; x; acc] + | _ -> Types.list [Types.symbol "cons"; quasiquote elt; acc] let is_macro_call ast env = match ast with @@ -61,7 +63,7 @@ and eval ast env = | T.Fn { T.value = f; T.meta = meta } -> let fn = T.Fn { T.value = f; meta = Core.assoc [meta; Core.kw_macro; (T.Bool true)]} in Env.set env key fn; fn - | _ -> raise (Invalid_argument "devmacro! value must be a fn")) + | _ -> raise (Invalid_argument "defmacro! value must be a fn")) | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> (let sub_env = Env.make (Some env) in @@ -95,6 +97,8 @@ and eval ast env = in bind_args arg_names args; eval expr sub_env) | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast + | T.List { T.value = [T.Symbol { T.value = "quasiquoteexpand" }; ast] } -> + quasiquote ast | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> eval (quasiquote ast) env | T.List { T.value = [T.Symbol { T.value = "macroexpand" }; ast] } -> diff --git a/impls/ocaml/stepA_mal.ml b/impls/ocaml/stepA_mal.ml index e89efc43..9c4689f3 100644 --- a/impls/ocaml/stepA_mal.ml +++ b/impls/ocaml/stepA_mal.ml @@ -5,14 +5,16 @@ let repl_env = Env.make (Some Core.ns) let rec quasiquote ast = match ast with | T.List { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.Vector { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast - | T.List { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } - | T.Vector { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } -> - Types.list [Types.symbol "concat"; head; quasiquote (Types.list tail)] - | T.List { T.value = head :: tail } - | T.Vector { T.value = head :: tail } -> - Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ] - | ast -> Types.list [Types.symbol "quote"; ast] + | T.List {T.value = xs} -> List.fold_right qq_folder xs (Types.list []) + | T.Vector {T.value = xs} -> Types.list [Types.symbol "vec"; + List.fold_right qq_folder xs (Types.list [])] + | T.Map _ -> Types.list [Types.symbol "quote"; ast] + | T.Symbol _ -> Types.list [Types.symbol "quote"; ast] + | _ -> ast +and qq_folder elt acc = + match elt with + | T.List {T.value = [T.Symbol {T.value = "splice-unquote"}; x]} -> Types.list [Types.symbol "concat"; x; acc] + | _ -> Types.list [Types.symbol "cons"; quasiquote elt; acc] let is_macro_call ast env = match ast with @@ -61,7 +63,7 @@ and eval ast env = | T.Fn { T.value = f; T.meta = meta } -> let fn = T.Fn { T.value = f; meta = Core.assoc [meta; Core.kw_macro; (T.Bool true)]} in Env.set env key fn; fn - | _ -> raise (Invalid_argument "devmacro! value must be a fn")) + | _ -> raise (Invalid_argument "defmacro! value must be a fn")) | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> (let sub_env = Env.make (Some env) in @@ -95,6 +97,8 @@ and eval ast env = in bind_args arg_names args; eval expr sub_env) | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast + | T.List { T.value = [T.Symbol { T.value = "quasiquoteexpand" }; ast] } -> + quasiquote ast | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> eval (quasiquote ast) env | T.List { T.value = [T.Symbol { T.value = "macroexpand" }; ast] } -> diff --git a/impls/perl/core.pm b/impls/perl/core.pm index 2e462eb0..5287d0ea 100644 --- a/impls/perl/core.pm +++ b/impls/perl/core.pm @@ -217,6 +217,7 @@ sub pl_STAR { 'rest' => sub { $_[0]->rest() }, 'cons' => \&cons, 'concat' => sub { Mal::List->new([map @$_, @_]) }, + 'vec' => sub { Mal::Vector->new([@{$_[0]}]) }, 'empty?' => sub { @{$_[0]} ? $false : $true }, 'count' => sub { Mal::Integer->new(scalar(@{$_[0]})) }, 'apply' => \&apply, diff --git a/impls/perl/step7_quote.pl b/impls/perl/step7_quote.pl index 2a0c0868..af87a293 100644 --- a/impls/perl/step7_quote.pl +++ b/impls/perl/step7_quote.pl @@ -23,26 +23,34 @@ sub READ { } # eval -sub is_pair { - my ($x) = @_; - return $x->isa('Mal::Sequence') && @$x; +sub starts_with { + my ($ast, $sym) = @_; + return @$ast && $ast->[0]->isa('Mal::Symbol') && ${$ast->[0]} eq $sym; +} +sub quasiquote_loop { + my ($ast) = @_; + my $res = Mal::List->new([]); + foreach my $elt (reverse @$ast) { + if ($elt->isa('Mal::List') and starts_with($elt, 'splice-unquote')) { + $res = Mal::List->new([Mal::Symbol->new('concat'), $elt->[1], $res]); + } else { + $res = Mal::List->new([Mal::Symbol->new('cons'), quasiquote($elt), $res]); + } + } + return $res; } - sub quasiquote { my ($ast) = @_; - if (!is_pair($ast)) { + if ($ast->isa('Mal::Vector')) { + return Mal::List->new([Mal::Symbol->new('vec'), quasiquote_loop($ast)]); + } elsif ($ast->isa('Mal::HashMap') or $ast->isa('Mal::Symbol')) { return Mal::List->new([Mal::Symbol->new("quote"), $ast]); - } elsif ($ast->[0]->isa('Mal::Symbol') && ${$ast->[0]} eq 'unquote') { + } elsif (!$ast->isa('Mal::List')) { + return $ast; + } elsif (starts_with($ast, 'unquote')) { return $ast->[1]; - } elsif (is_pair($ast->[0]) && $ast->[0]->[0]->isa('Mal::Symbol') && - ${$ast->[0]->[0]} eq 'splice-unquote') { - return Mal::List->new([Mal::Symbol->new("concat"), - $ast->[0]->[1], - quasiquote($ast->rest())]); } else { - return Mal::List->new([Mal::Symbol->new("cons"), - quasiquote($ast->[0]), - quasiquote($ast->rest())]); + return quasiquote_loop($ast); } } @@ -88,6 +96,9 @@ sub EVAL { when ('quote') { return $ast->[1]; } + when ('quasiquoteexpand') { + return quasiquote($ast->[1]); + } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; diff --git a/impls/perl/step8_macros.pl b/impls/perl/step8_macros.pl index 87a47c84..727d2eec 100644 --- a/impls/perl/step8_macros.pl +++ b/impls/perl/step8_macros.pl @@ -23,26 +23,34 @@ sub READ { } # eval -sub is_pair { - my ($x) = @_; - return $x->isa('Mal::Sequence') && @$x; +sub starts_with { + my ($ast, $sym) = @_; + return @$ast && $ast->[0]->isa('Mal::Symbol') && ${$ast->[0]} eq $sym; +} +sub quasiquote_loop { + my ($ast) = @_; + my $res = Mal::List->new([]); + foreach my $elt (reverse @$ast) { + if ($elt->isa('Mal::List') and starts_with($elt, 'splice-unquote')) { + $res = Mal::List->new([Mal::Symbol->new('concat'), $elt->[1], $res]); + } else { + $res = Mal::List->new([Mal::Symbol->new('cons'), quasiquote($elt), $res]); + } + } + return $res; } - sub quasiquote { my ($ast) = @_; - if (!is_pair($ast)) { + if ($ast->isa('Mal::Vector')) { + return Mal::List->new([Mal::Symbol->new('vec'), quasiquote_loop($ast)]); + } elsif ($ast->isa('Mal::HashMap') or $ast->isa('Mal::Symbol')) { return Mal::List->new([Mal::Symbol->new("quote"), $ast]); - } elsif ($ast->[0]->isa('Mal::Symbol') && ${$ast->[0]} eq 'unquote') { + } elsif (!$ast->isa('Mal::List')) { + return $ast; + } elsif (starts_with($ast, 'unquote')) { return $ast->[1]; - } elsif (is_pair($ast->[0]) && $ast->[0]->[0]->isa('Mal::Symbol') && - ${$ast->[0]->[0]} eq 'splice-unquote') { - return Mal::List->new([Mal::Symbol->new("concat"), - $ast->[0]->[1], - quasiquote($ast->rest())]); } else { - return Mal::List->new([Mal::Symbol->new("cons"), - quasiquote($ast->[0]), - quasiquote($ast->rest())]); + return quasiquote_loop($ast); } } @@ -117,6 +125,9 @@ sub EVAL { when ('quote') { return $ast->[1]; } + when ('quasiquoteexpand') { + return quasiquote($ast->[1]); + } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; diff --git a/impls/perl/step9_try.pl b/impls/perl/step9_try.pl index 208ad959..dd1ca143 100644 --- a/impls/perl/step9_try.pl +++ b/impls/perl/step9_try.pl @@ -24,26 +24,34 @@ sub READ { } # eval -sub is_pair { - my ($x) = @_; - return $x->isa('Mal::Sequence') && @$x; +sub starts_with { + my ($ast, $sym) = @_; + return @$ast && $ast->[0]->isa('Mal::Symbol') && ${$ast->[0]} eq $sym; +} +sub quasiquote_loop { + my ($ast) = @_; + my $res = Mal::List->new([]); + foreach my $elt (reverse @$ast) { + if ($elt->isa('Mal::List') and starts_with($elt, 'splice-unquote')) { + $res = Mal::List->new([Mal::Symbol->new('concat'), $elt->[1], $res]); + } else { + $res = Mal::List->new([Mal::Symbol->new('cons'), quasiquote($elt), $res]); + } + } + return $res; } - sub quasiquote { my ($ast) = @_; - if (!is_pair($ast)) { + if ($ast->isa('Mal::Vector')) { + return Mal::List->new([Mal::Symbol->new('vec'), quasiquote_loop($ast)]); + } elsif ($ast->isa('Mal::HashMap') or $ast->isa('Mal::Symbol')) { return Mal::List->new([Mal::Symbol->new("quote"), $ast]); - } elsif ($ast->[0]->isa('Mal::Symbol') && ${$ast->[0]} eq 'unquote') { + } elsif (!$ast->isa('Mal::List')) { + return $ast; + } elsif (starts_with($ast, 'unquote')) { return $ast->[1]; - } elsif (is_pair($ast->[0]) && $ast->[0]->[0]->isa('Mal::Symbol') && - ${$ast->[0]->[0]} eq 'splice-unquote') { - return Mal::List->new([Mal::Symbol->new("concat"), - $ast->[0]->[1], - quasiquote($ast->rest())]); } else { - return Mal::List->new([Mal::Symbol->new("cons"), - quasiquote($ast->[0]), - quasiquote($ast->rest())]); + return quasiquote_loop($ast); } } @@ -118,6 +126,9 @@ sub EVAL { when ('quote') { return $ast->[1]; } + when ('quasiquoteexpand') { + return quasiquote($ast->[1]); + } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; diff --git a/impls/perl/stepA_mal.pl b/impls/perl/stepA_mal.pl index f9fbfe6e..f62aa5a7 100644 --- a/impls/perl/stepA_mal.pl +++ b/impls/perl/stepA_mal.pl @@ -23,26 +23,34 @@ sub READ { } # eval -sub is_pair { - my ($x) = @_; - return $x->isa('Mal::Sequence') && @$x; +sub starts_with { + my ($ast, $sym) = @_; + return @$ast && $ast->[0]->isa('Mal::Symbol') && ${$ast->[0]} eq $sym; +} +sub quasiquote_loop { + my ($ast) = @_; + my $res = Mal::List->new([]); + foreach my $elt (reverse @$ast) { + if ($elt->isa('Mal::List') and starts_with($elt, 'splice-unquote')) { + $res = Mal::List->new([Mal::Symbol->new('concat'), $elt->[1], $res]); + } else { + $res = Mal::List->new([Mal::Symbol->new('cons'), quasiquote($elt), $res]); + } + } + return $res; } - sub quasiquote { my ($ast) = @_; - if (!is_pair($ast)) { + if ($ast->isa('Mal::Vector')) { + return Mal::List->new([Mal::Symbol->new('vec'), quasiquote_loop($ast)]); + } elsif ($ast->isa('Mal::HashMap') or $ast->isa('Mal::Symbol')) { return Mal::List->new([Mal::Symbol->new("quote"), $ast]); - } elsif ($ast->[0]->isa('Mal::Symbol') && ${$ast->[0]} eq 'unquote') { + } elsif (!$ast->isa('Mal::List')) { + return $ast; + } elsif (starts_with($ast, 'unquote')) { return $ast->[1]; - } elsif (is_pair($ast->[0]) && $ast->[0]->[0]->isa('Mal::Symbol') && - ${$ast->[0]->[0]} eq 'splice-unquote') { - return Mal::List->new([Mal::Symbol->new("concat"), - $ast->[0]->[1], - quasiquote($ast->rest())]); } else { - return Mal::List->new([Mal::Symbol->new("cons"), - quasiquote($ast->[0]), - quasiquote($ast->rest())]); + return quasiquote_loop($ast); } } @@ -117,6 +125,9 @@ sub EVAL { when ('quote') { return $ast->[1]; } + when ('quasiquoteexpand') { + return quasiquote($ast->[1]); + } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; diff --git a/impls/perl6/core.pm b/impls/perl6/core.pm index 50baa455..f5cc5d1c 100644 --- a/impls/perl6/core.pm +++ b/impls/perl6/core.pm @@ -66,6 +66,7 @@ our %ns = ( 'swap!' => MalCode(-> $atom, $func, *@args { $atom.val = $func.apply($atom.val, |@args) }), cons => MalCode({ MalList([$^a, |$^b.val]) }), concat => MalCode({ MalList([@_.map({|$_.val})]) }), + vec => MalCode({ MalVector([|$^a.val]) }), nth => MalCode({ $^a[$^b.val] // die X::MalOutOfRange.new }), first => MalCode({ $^a[0] // $NIL }), rest => MalCode({ MalList([$^a[1..*]]) }), diff --git a/impls/perl6/step7_quote.pl b/impls/perl6/step7_quote.pl index 0bbbb2af..8b8379f1 100644 --- a/impls/perl6/step7_quote.pl +++ b/impls/perl6/step7_quote.pl @@ -20,22 +20,33 @@ sub eval_ast ($ast, $env) { } } -sub is_pair ($ast) { - return so $ast ~~ MalList|MalVector && $ast.elems; +sub qqLoop ($ast) { + my $acc = MalList([]); + for |$ast.val.reverse -> $elt { + if $elt ~~ MalList && $elt.elems == 2 && $elt[0] ~~ MalSymbol + && $elt[0].val eq 'splice-unquote' + { + $acc = MalList([MalSymbol('concat'), $elt[1], $acc]); + } + else { + $acc = MalList([MalSymbol('cons'), quasiquote($elt), $acc]); + } + } + return $acc; } sub quasiquote ($ast) { - if !is_pair($ast) { - return MalList([MalSymbol('quote'), $ast]); - } - elsif $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { - return $ast[1]; - } - elsif is_pair($ast[0]) && $ast[0][0] ~~ MalSymbol && $ast[0][0].val eq 'splice-unquote' { - return MalList([MalSymbol('concat'), $ast[0][1], quasiquote(MalList([$ast[1..*]]))]); - } - else { - return MalList([MalSymbol('cons'), quasiquote($ast[0]), quasiquote(MalList([$ast[1..*]]))]); + given $ast { + when MalList { + if $ast.elems == 2 && $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { + $ast[1] + } else { + qqLoop($ast); + } + } + when MalVector { MalList([MalSymbol('vec'), qqLoop($ast)]) } + when MalSymbol|MalHashMap { MalList([MalSymbol('quote'), $ast]) } + default { $ast } } } @@ -78,6 +89,7 @@ sub eval ($ast is copy, $env is copy) { return MalFunction($a2, $env, @binds, &fn); } when 'quote' { return $a1 } + when 'quasiquoteexpand' { return quasiquote($a1) } when 'quasiquote' { $ast = quasiquote($a1) } default { my ($func, @args) = eval_ast($ast, $env).val; diff --git a/impls/perl6/step8_macros.pl b/impls/perl6/step8_macros.pl index d5f6e55e..d56b96f5 100644 --- a/impls/perl6/step8_macros.pl +++ b/impls/perl6/step8_macros.pl @@ -20,22 +20,33 @@ sub eval_ast ($ast, $env) { } } -sub is_pair ($ast) { - return so $ast ~~ MalList|MalVector && $ast.elems; +sub qqLoop ($ast) { + my $acc = MalList([]); + for |$ast.val.reverse -> $elt { + if $elt ~~ MalList && $elt.elems == 2 && $elt[0] ~~ MalSymbol + && $elt[0].val eq 'splice-unquote' + { + $acc = MalList([MalSymbol('concat'), $elt[1], $acc]); + } + else { + $acc = MalList([MalSymbol('cons'), quasiquote($elt), $acc]); + } + } + return $acc; } sub quasiquote ($ast) { - if !is_pair($ast) { - return MalList([MalSymbol('quote'), $ast]); - } - elsif $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { - return $ast[1]; - } - elsif is_pair($ast[0]) && $ast[0][0] ~~ MalSymbol && $ast[0][0].val eq 'splice-unquote' { - return MalList([MalSymbol('concat'), $ast[0][1], quasiquote(MalList([$ast[1..*]]))]); - } - else { - return MalList([MalSymbol('cons'), quasiquote($ast[0]), quasiquote(MalList([$ast[1..*]]))]); + given $ast { + when MalList { + if $ast.elems == 2 && $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { + $ast[1] + } else { + qqLoop($ast); + } + } + when MalVector { MalList([MalSymbol('vec'), qqLoop($ast)]) } + when MalSymbol|MalHashMap { MalList([MalSymbol('quote'), $ast]) } + default { $ast } } } @@ -93,6 +104,7 @@ sub eval ($ast is copy, $env is copy) { return MalFunction($a2, $env, @binds, &fn); } when 'quote' { return $a1 } + when 'quasiquoteexpand' { return quasiquote($a1) } when 'quasiquote' { $ast = quasiquote($a1) } when 'defmacro!' { my $func = eval($a2, $env); diff --git a/impls/perl6/step9_try.pl b/impls/perl6/step9_try.pl index 9a658a57..19fe75c4 100644 --- a/impls/perl6/step9_try.pl +++ b/impls/perl6/step9_try.pl @@ -20,22 +20,33 @@ sub eval_ast ($ast, $env) { } } -sub is_pair ($ast) { - return so $ast ~~ MalList|MalVector && $ast.elems; +sub qqLoop ($ast) { + my $acc = MalList([]); + for |$ast.val.reverse -> $elt { + if $elt ~~ MalList && $elt.elems == 2 && $elt[0] ~~ MalSymbol + && $elt[0].val eq 'splice-unquote' + { + $acc = MalList([MalSymbol('concat'), $elt[1], $acc]); + } + else { + $acc = MalList([MalSymbol('cons'), quasiquote($elt), $acc]); + } + } + return $acc; } sub quasiquote ($ast) { - if !is_pair($ast) { - return MalList([MalSymbol('quote'), $ast]); - } - elsif $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { - return $ast[1]; - } - elsif is_pair($ast[0]) && $ast[0][0] ~~ MalSymbol && $ast[0][0].val eq 'splice-unquote' { - return MalList([MalSymbol('concat'), $ast[0][1], quasiquote(MalList([$ast[1..*]]))]); - } - else { - return MalList([MalSymbol('cons'), quasiquote($ast[0]), quasiquote(MalList([$ast[1..*]]))]); + given $ast { + when MalList { + if $ast.elems == 2 && $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { + $ast[1] + } else { + qqLoop($ast); + } + } + when MalVector { MalList([MalSymbol('vec'), qqLoop($ast)]) } + when MalSymbol|MalHashMap { MalList([MalSymbol('quote'), $ast]) } + default { $ast } } } @@ -93,6 +104,7 @@ sub eval ($ast is copy, $env is copy) { return MalFunction($a2, $env, @binds, &fn); } when 'quote' { return $a1 } + when 'quasiquoteexpand' { return quasiquote($a1) } when 'quasiquote' { $ast = quasiquote($a1) } when 'defmacro!' { my $func = eval($a2, $env); diff --git a/impls/perl6/stepA_mal.pl b/impls/perl6/stepA_mal.pl index 847b4544..e6854348 100644 --- a/impls/perl6/stepA_mal.pl +++ b/impls/perl6/stepA_mal.pl @@ -20,22 +20,33 @@ sub eval_ast ($ast, $env) { } } -sub is_pair ($ast) { - return so $ast ~~ MalList|MalVector && $ast.elems; +sub qqLoop ($ast) { + my $acc = MalList([]); + for |$ast.val.reverse -> $elt { + if $elt ~~ MalList && $elt.elems == 2 && $elt[0] ~~ MalSymbol + && $elt[0].val eq 'splice-unquote' + { + $acc = MalList([MalSymbol('concat'), $elt[1], $acc]); + } + else { + $acc = MalList([MalSymbol('cons'), quasiquote($elt), $acc]); + } + } + return $acc; } sub quasiquote ($ast) { - if !is_pair($ast) { - return MalList([MalSymbol('quote'), $ast]); - } - elsif $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { - return $ast[1]; - } - elsif is_pair($ast[0]) && $ast[0][0] ~~ MalSymbol && $ast[0][0].val eq 'splice-unquote' { - return MalList([MalSymbol('concat'), $ast[0][1], quasiquote(MalList([$ast[1..*]]))]); - } - else { - return MalList([MalSymbol('cons'), quasiquote($ast[0]), quasiquote(MalList([$ast[1..*]]))]); + given $ast { + when MalList { + if $ast.elems == 2 && $ast[0] ~~ MalSymbol && $ast[0].val eq 'unquote' { + $ast[1] + } else { + qqLoop($ast); + } + } + when MalVector { MalList([MalSymbol('vec'), qqLoop($ast)]) } + when MalSymbol|MalHashMap { MalList([MalSymbol('quote'), $ast]) } + default { $ast } } } @@ -93,6 +104,7 @@ sub eval ($ast is copy, $env is copy) { return MalFunction($a2, $env, @binds, &fn); } when 'quote' { return $a1 } + when 'quasiquoteexpand' { return quasiquote($a1) } when 'quasiquote' { $ast = quasiquote($a1) } when 'defmacro!' { my $func = eval($a2, $env); diff --git a/impls/php/core.php b/impls/php/core.php index 7fe6d353..6e87e0c1 100644 --- a/impls/php/core.php +++ b/impls/php/core.php @@ -97,6 +97,16 @@ function concat() { return $l; } +function vec($a) { + if (_vector_Q($a)) { + return $a; + } else { + $v = new VectorClass(); + $v->exchangeArray($a->getArrayCopy()); + return $v; + } +} + function nth($seq, $idx) { if ($idx < $seq->count()) { return $seq[$idx]; @@ -252,6 +262,7 @@ $core_ns = array( 'sequential?'=> function ($a) { return _sequential_Q($a); }, 'cons'=> function ($a, $b) { return cons($a, $b); }, 'concat'=> function () { return call_user_func_array('concat', func_get_args()); }, + 'vec'=> function ($a) { return vec($a, $b); }, 'nth'=> function ($a, $b) { return nth($a, $b); }, 'first'=> function ($a) { return first($a); }, 'rest'=> function ($a) { return rest($a); }, diff --git a/impls/php/step7_quote.php b/impls/php/step7_quote.php index 5b7885be..a3f2b1f5 100644 --- a/impls/php/step7_quote.php +++ b/impls/php/step7_quote.php @@ -13,22 +13,36 @@ function READ($str) { } // eval -function is_pair($x) { - return _sequential_Q($x) and count($x) > 0; +function qq_loop($elt, $acc) { + if (_list_Q($elt) + and count($elt) == 2 + and _symbol_Q($elt[0]) + and $elt[0]->value === 'splice-unquote') { + return _list(_symbol("concat"), $elt[1], $acc); + } else { + return _list(_symbol("cons"), quasiquote($elt), $acc); + } +} + +function qq_foldr($xs) { + $acc = _list(); + for ($i=count($xs)-1; 0<=$i; $i-=1) { + $acc = qq_loop($xs[$i], $acc); + } + return $acc; } function quasiquote($ast) { - if (!is_pair($ast)) { + if (_vector_Q($ast)) { + return _list(_symbol("vec"), qq_foldr($ast)); + } elseif (_symbol_Q($ast) or _hash_map_Q($ast)) { return _list(_symbol("quote"), $ast); - } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { + } elseif (!_list_Q($ast)) { + return $ast; + } elseif (count($ast) == 2 and _symbol_Q($ast[0]) and $ast[0]->value === 'unquote') { return $ast[1]; - } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && - $ast[0][0]->value === 'splice-unquote') { - return _list(_symbol("concat"), $ast[0][1], - quasiquote($ast->slice(1))); } else { - return _list(_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); + return qq_foldr($ast); } } @@ -83,6 +97,8 @@ function MAL_EVAL($ast, $env) { break; // Continue loop (TCO) case "quote": return $ast[1]; + case "quasiquoteexpand": + return quasiquote($ast[1]); case "quasiquote": $ast = quasiquote($ast[1]); break; // Continue loop (TCO) diff --git a/impls/php/step8_macros.php b/impls/php/step8_macros.php index 20b6d256..0eece751 100644 --- a/impls/php/step8_macros.php +++ b/impls/php/step8_macros.php @@ -13,27 +13,42 @@ function READ($str) { } // eval -function is_pair($x) { - return _sequential_Q($x) and count($x) > 0; +function qq_loop($elt, $acc) { + if (_list_Q($elt) + and count($elt) == 2 + and _symbol_Q($elt[0]) + and $elt[0]->value === 'splice-unquote') { + return _list(_symbol("concat"), $elt[1], $acc); + } else { + return _list(_symbol("cons"), quasiquote($elt), $acc); + } +} + +function qq_foldr($xs) { + $acc = _list(); + for ($i=count($xs)-1; 0<=$i; $i-=1) { + $acc = qq_loop($xs[$i], $acc); + } + return $acc; } function quasiquote($ast) { - if (!is_pair($ast)) { + if (_vector_Q($ast)) { + return _list(_symbol("vec"), qq_foldr($ast)); + } elseif (_symbol_Q($ast) or _hash_map_Q($ast)) { return _list(_symbol("quote"), $ast); - } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { + } elseif (!_list_Q($ast)) { + return $ast; + } elseif (count($ast) == 2 and _symbol_Q($ast[0]) and $ast[0]->value === 'unquote') { return $ast[1]; - } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && - $ast[0][0]->value === 'splice-unquote') { - return _list(_symbol("concat"), $ast[0][1], - quasiquote($ast->slice(1))); } else { - return _list(_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); + return qq_foldr($ast); } } function is_macro_call($ast, $env) { - return is_pair($ast) && + return _list_Q($ast) && + count($ast) >0 && _symbol_Q($ast[0]) && $env->find($ast[0]) && $env->get($ast[0])->ismacro; @@ -104,6 +119,8 @@ function MAL_EVAL($ast, $env) { break; // Continue loop (TCO) case "quote": return $ast[1]; + case "quasiquoteexpand": + return quasiquote($ast[1]); case "quasiquote": $ast = quasiquote($ast[1]); break; // Continue loop (TCO) diff --git a/impls/php/step9_try.php b/impls/php/step9_try.php index 2c84a077..69b0e2f5 100644 --- a/impls/php/step9_try.php +++ b/impls/php/step9_try.php @@ -13,27 +13,42 @@ function READ($str) { } // eval -function is_pair($x) { - return _sequential_Q($x) and count($x) > 0; +function qq_loop($elt, $acc) { + if (_list_Q($elt) + and count($elt) == 2 + and _symbol_Q($elt[0]) + and $elt[0]->value === 'splice-unquote') { + return _list(_symbol("concat"), $elt[1], $acc); + } else { + return _list(_symbol("cons"), quasiquote($elt), $acc); + } +} + +function qq_foldr($xs) { + $acc = _list(); + for ($i=count($xs)-1; 0<=$i; $i-=1) { + $acc = qq_loop($xs[$i], $acc); + } + return $acc; } function quasiquote($ast) { - if (!is_pair($ast)) { + if (_vector_Q($ast)) { + return _list(_symbol("vec"), qq_foldr($ast)); + } elseif (_symbol_Q($ast) or _hash_map_Q($ast)) { return _list(_symbol("quote"), $ast); - } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { + } elseif (!_list_Q($ast)) { + return $ast; + } elseif (count($ast) == 2 and _symbol_Q($ast[0]) and $ast[0]->value === 'unquote') { return $ast[1]; - } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && - $ast[0][0]->value === 'splice-unquote') { - return _list(_symbol("concat"), $ast[0][1], - quasiquote($ast->slice(1))); } else { - return _list(_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); + return qq_foldr($ast); } } function is_macro_call($ast, $env) { - return is_pair($ast) && + return _list_Q($ast) && + count($ast) >0 && _symbol_Q($ast[0]) && $env->find($ast[0]) && $env->get($ast[0])->ismacro; @@ -104,6 +119,8 @@ function MAL_EVAL($ast, $env) { break; // Continue loop (TCO) case "quote": return $ast[1]; + case "quasiquoteexpand": + return quasiquote($ast[1]); case "quasiquote": $ast = quasiquote($ast[1]); break; // Continue loop (TCO) diff --git a/impls/php/stepA_mal.php b/impls/php/stepA_mal.php index eef4dfe4..3565a3d9 100644 --- a/impls/php/stepA_mal.php +++ b/impls/php/stepA_mal.php @@ -14,27 +14,42 @@ function READ($str) { } // eval -function is_pair($x) { - return _sequential_Q($x) and count($x) > 0; +function qq_loop($elt, $acc) { + if (_list_Q($elt) + and count($elt) == 2 + and _symbol_Q($elt[0]) + and $elt[0]->value === 'splice-unquote') { + return _list(_symbol("concat"), $elt[1], $acc); + } else { + return _list(_symbol("cons"), quasiquote($elt), $acc); + } +} + +function qq_foldr($xs) { + $acc = _list(); + for ($i=count($xs)-1; 0<=$i; $i-=1) { + $acc = qq_loop($xs[$i], $acc); + } + return $acc; } function quasiquote($ast) { - if (!is_pair($ast)) { + if (_vector_Q($ast)) { + return _list(_symbol("vec"), qq_foldr($ast)); + } elseif (_symbol_Q($ast) or _hash_map_Q($ast)) { return _list(_symbol("quote"), $ast); - } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { + } elseif (!_list_Q($ast)) { + return $ast; + } elseif (count($ast) == 2 and _symbol_Q($ast[0]) and $ast[0]->value === 'unquote') { return $ast[1]; - } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && - $ast[0][0]->value === 'splice-unquote') { - return _list(_symbol("concat"), $ast[0][1], - quasiquote($ast->slice(1))); } else { - return _list(_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); + return qq_foldr($ast); } } function is_macro_call($ast, $env) { - return is_pair($ast) && + return _list_Q($ast) && + count($ast) >0 && _symbol_Q($ast[0]) && $env->find($ast[0]) && $env->get($ast[0])->ismacro; @@ -105,6 +120,8 @@ function MAL_EVAL($ast, $env) { break; // Continue loop (TCO) case "quote": return $ast[1]; + case "quasiquoteexpand": + return quasiquote($ast[1]); case "quasiquote": $ast = quasiquote($ast[1]); break; // Continue loop (TCO) diff --git a/impls/picolisp/core.l b/impls/picolisp/core.l index 0ef572c9..a549d782 100644 --- a/impls/picolisp/core.l +++ b/impls/picolisp/core.l @@ -133,6 +133,7 @@ (cons . `(MAL-fn '((X Seq) (MAL-list (cons X (MAL-value Seq)))))) (concat . `(MAL-fn '(@ (MAL-list (apply append (mapcar MAL-value (rest))))))) + (vec . `(MAL-fn '((Seq) (MAL-vector (MAL-value Seq))))) (nth . `(MAL-fn MAL-nth)) (first . `(MAL-fn '((X) (if (MAL-seq? X) (or (car (MAL-value X)) *MAL-nil) *MAL-nil)))) diff --git a/impls/picolisp/step7_quote.l b/impls/picolisp/step7_quote.l index e1a107f7..72fa6450 100644 --- a/impls/picolisp/step7_quote.l +++ b/impls/picolisp/step7_quote.l @@ -15,25 +15,31 @@ (def '*ReplEnv (MAL-env NIL)) (for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) -(de is-pair (Ast) - (and (memq (MAL-type Ast) '(list vector)) (MAL-value Ast) T) ) +(de starts-with (Ast Sym) ;; MAL list, symbol -> nil or second element of Ast + (let (L (MAL-value Ast) + A0 (car L)) + (and (= (MAL-type A0) 'symbol) + (= (MAL-value A0) Sym) + (cadr L)))) + +(de quasiquote-loop (Xs) ;; list -> MAL list + (MAL-list + (when Xs + (let (Elt (car Xs) + Unq (when (= (MAL-type Elt) 'list) + (starts-with Elt 'splice-unquote)) + Acc (quasiquote-loop (cdr Xs))) + (if Unq + (list (MAL-symbol 'concat) Unq Acc) + (list (MAL-symbol 'cons) (quasiquote Elt) Acc)))))) (de quasiquote (Ast) - (if (not (is-pair Ast)) - (MAL-list (list (MAL-symbol 'quote) Ast)) - (let A (MAL-value Ast) - (cond - ((= (MAL-value (car A)) 'unquote) - (cadr A) ) - ((and (is-pair (car A)) - (= (MAL-value (car (MAL-value (car A)))) 'splice-unquote) ) - (MAL-list (list (MAL-symbol 'concat) - (cadr (MAL-value (car A))) - (quasiquote (MAL-list (cdr A))) ) ) ) - (T - (MAL-list (list (MAL-symbol 'cons) - (quasiquote (car A)) - (quasiquote (MAL-list (cdr A))) ) ) ) ) ) ) ) + (case (MAL-type Ast) + (list (or (starts-with Ast 'unquote) + (quasiquote-loop (MAL-value Ast)))) + (vector (MAL-list (list (MAL-symbol 'vec) (quasiquote-loop (MAL-value Ast))))) + ((map symbol) (MAL-list (list (MAL-symbol 'quote) Ast))) + (T Ast))) (de EVAL (Ast Env) (catch 'done @@ -50,6 +56,8 @@ (throw 'done (set> Env A1* (EVAL A2 Env))) ) ((= A0* 'quote) (throw 'done A1) ) + ((= A0* 'quasiquoteexpand) + (throw 'done (quasiquote A1))) ((= A0* 'quasiquote) (setq Ast (quasiquote A1)) ) # TCO ((= A0* 'let*) diff --git a/impls/picolisp/step8_macros.l b/impls/picolisp/step8_macros.l index 389bb313..044c4e5a 100644 --- a/impls/picolisp/step8_macros.l +++ b/impls/picolisp/step8_macros.l @@ -15,25 +15,31 @@ (def '*ReplEnv (MAL-env NIL)) (for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) -(de is-pair (Ast) - (and (memq (MAL-type Ast) '(list vector)) (MAL-value Ast) T) ) +(de starts-with (Ast Sym) ;; MAL list, symbol -> nil or second element of Ast + (let (L (MAL-value Ast) + A0 (car L)) + (and (= (MAL-type A0) 'symbol) + (= (MAL-value A0) Sym) + (cadr L)))) + +(de quasiquote-loop (Xs) ;; list -> MAL list + (MAL-list + (when Xs + (let (Elt (car Xs) + Unq (when (= (MAL-type Elt) 'list) + (starts-with Elt 'splice-unquote)) + Acc (quasiquote-loop (cdr Xs))) + (if Unq + (list (MAL-symbol 'concat) Unq Acc) + (list (MAL-symbol 'cons) (quasiquote Elt) Acc)))))) (de quasiquote (Ast) - (if (not (is-pair Ast)) - (MAL-list (list (MAL-symbol 'quote) Ast)) - (let A (MAL-value Ast) - (cond - ((= (MAL-value (car A)) 'unquote) - (cadr A) ) - ((and (is-pair (car A)) - (= (MAL-value (car (MAL-value (car A)))) 'splice-unquote) ) - (MAL-list (list (MAL-symbol 'concat) - (cadr (MAL-value (car A))) - (quasiquote (MAL-list (cdr A))) ) ) ) - (T - (MAL-list (list (MAL-symbol 'cons) - (quasiquote (car A)) - (quasiquote (MAL-list (cdr A))) ) ) ) ) ) ) ) + (case (MAL-type Ast) + (list (or (starts-with Ast 'unquote) + (quasiquote-loop (MAL-value Ast)))) + (vector (MAL-list (list (MAL-symbol 'vec) (quasiquote-loop (MAL-value Ast))))) + ((map symbol) (MAL-list (list (MAL-symbol 'quote) Ast))) + (T Ast))) (de is-macro-call (Ast Env) (when (= (MAL-type Ast) 'list) @@ -69,6 +75,8 @@ (throw 'done (set> Env A1* (EVAL A2 Env))) ) ((= A0* 'quote) (throw 'done A1) ) + ((= A0* 'quasiquoteexpand) + (throw 'done (quasiquote A1))) ((= A0* 'quasiquote) (setq Ast (quasiquote A1)) ) # TCO ((= A0* 'defmacro!) diff --git a/impls/picolisp/step9_try.l b/impls/picolisp/step9_try.l index de258658..1c6ff65e 100644 --- a/impls/picolisp/step9_try.l +++ b/impls/picolisp/step9_try.l @@ -15,25 +15,31 @@ (def '*ReplEnv (MAL-env NIL)) (for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) -(de is-pair (Ast) - (and (memq (MAL-type Ast) '(list vector)) (MAL-value Ast) T) ) +(de starts-with (Ast Sym) ;; MAL list, symbol -> nil or second element of Ast + (let (L (MAL-value Ast) + A0 (car L)) + (and (= (MAL-type A0) 'symbol) + (= (MAL-value A0) Sym) + (cadr L)))) + +(de quasiquote-loop (Xs) ;; list -> MAL list + (MAL-list + (when Xs + (let (Elt (car Xs) + Unq (when (= (MAL-type Elt) 'list) + (starts-with Elt 'splice-unquote)) + Acc (quasiquote-loop (cdr Xs))) + (if Unq + (list (MAL-symbol 'concat) Unq Acc) + (list (MAL-symbol 'cons) (quasiquote Elt) Acc)))))) (de quasiquote (Ast) - (if (not (is-pair Ast)) - (MAL-list (list (MAL-symbol 'quote) Ast)) - (let A (MAL-value Ast) - (cond - ((= (MAL-value (car A)) 'unquote) - (cadr A) ) - ((and (is-pair (car A)) - (= (MAL-value (car (MAL-value (car A)))) 'splice-unquote) ) - (MAL-list (list (MAL-symbol 'concat) - (cadr (MAL-value (car A))) - (quasiquote (MAL-list (cdr A))) ) ) ) - (T - (MAL-list (list (MAL-symbol 'cons) - (quasiquote (car A)) - (quasiquote (MAL-list (cdr A))) ) ) ) ) ) ) ) + (case (MAL-type Ast) + (list (or (starts-with Ast 'unquote) + (quasiquote-loop (MAL-value Ast)))) + (vector (MAL-list (list (MAL-symbol 'vec) (quasiquote-loop (MAL-value Ast))))) + ((map symbol) (MAL-list (list (MAL-symbol 'quote) Ast))) + (T Ast))) (de is-macro-call (Ast Env) (when (= (MAL-type Ast) 'list) @@ -69,6 +75,8 @@ (throw 'done (set> Env A1* (EVAL A2 Env))) ) ((= A0* 'quote) (throw 'done A1) ) + ((= A0* 'quasiquoteexpand) + (throw 'done (quasiquote A1))) ((= A0* 'quasiquote) (setq Ast (quasiquote A1)) ) # TCO ((= A0* 'defmacro!) diff --git a/impls/picolisp/stepA_mal.l b/impls/picolisp/stepA_mal.l index 005cab33..ab54bb25 100644 --- a/impls/picolisp/stepA_mal.l +++ b/impls/picolisp/stepA_mal.l @@ -15,25 +15,31 @@ (def '*ReplEnv (MAL-env NIL)) (for Bind *Ns (set> *ReplEnv (car Bind) (cdr Bind))) -(de is-pair (Ast) - (and (memq (MAL-type Ast) '(list vector)) (MAL-value Ast) T) ) +(de starts-with (Ast Sym) ;; MAL list, symbol -> nil or second element of Ast + (let (L (MAL-value Ast) + A0 (car L)) + (and (= (MAL-type A0) 'symbol) + (= (MAL-value A0) Sym) + (cadr L)))) + +(de quasiquote-loop (Xs) ;; list -> MAL list + (MAL-list + (when Xs + (let (Elt (car Xs) + Unq (when (= (MAL-type Elt) 'list) + (starts-with Elt 'splice-unquote)) + Acc (quasiquote-loop (cdr Xs))) + (if Unq + (list (MAL-symbol 'concat) Unq Acc) + (list (MAL-symbol 'cons) (quasiquote Elt) Acc)))))) (de quasiquote (Ast) - (if (not (is-pair Ast)) - (MAL-list (list (MAL-symbol 'quote) Ast)) - (let A (MAL-value Ast) - (cond - ((= (MAL-value (car A)) 'unquote) - (cadr A) ) - ((and (is-pair (car A)) - (= (MAL-value (car (MAL-value (car A)))) 'splice-unquote) ) - (MAL-list (list (MAL-symbol 'concat) - (cadr (MAL-value (car A))) - (quasiquote (MAL-list (cdr A))) ) ) ) - (T - (MAL-list (list (MAL-symbol 'cons) - (quasiquote (car A)) - (quasiquote (MAL-list (cdr A))) ) ) ) ) ) ) ) + (case (MAL-type Ast) + (list (or (starts-with Ast 'unquote) + (quasiquote-loop (MAL-value Ast)))) + (vector (MAL-list (list (MAL-symbol 'vec) (quasiquote-loop (MAL-value Ast))))) + ((map symbol) (MAL-list (list (MAL-symbol 'quote) Ast))) + (T Ast))) (de is-macro-call (Ast Env) (when (= (MAL-type Ast) 'list) @@ -69,6 +75,8 @@ (throw 'done (set> Env A1* (EVAL A2 Env))) ) ((= A0* 'quote) (throw 'done A1) ) + ((= A0* 'quasiquoteexpand) + (throw 'done (quasiquote A1))) ((= A0* 'quasiquote) (setq Ast (quasiquote A1)) ) # TCO ((= A0* 'defmacro!) diff --git a/impls/pike/Core.pmod b/impls/pike/Core.pmod index fc50d4df..74b6d9c3 100644 --- a/impls/pike/Core.pmod +++ b/impls/pike/Core.pmod @@ -67,6 +67,7 @@ private mapping(string:function) builtins = ([ "sequential?": lambda(Val a) { return to_bool(a.is_sequence); }, "cons": lambda(Val a, Val b) { return List(({ a }) + b.data); }, "concat": lambda(Val ... a) { return List(`+(({ }), @map(a, lambda(Val e) { return e.data; }))); }, + "vec": lambda(Val a) { return Vector(a.data); }, "nth": lambda(Val a, Val b) { return a.nth(b.value); }, "first": lambda(Val a) { return a.first(); }, "rest": lambda(Val a) { return a.rest(); }, diff --git a/impls/pike/step7_quote.pike b/impls/pike/step7_quote.pike index 2c1d36f1..55cba4f6 100644 --- a/impls/pike/step7_quote.pike +++ b/impls/pike/step7_quote.pike @@ -9,21 +9,45 @@ Val READ(string str) return read_str(str); } -bool is_pair(Val e) +bool starts_with(Val ast, string sym) { - return e.is_sequence && !e.emptyp(); + return ast.mal_type == MALTYPE_LIST && + !ast.emptyp() && + ast.data[0].mal_type == MALTYPE_SYMBOL && + ast.data[0].value == sym; +} + +Val quasiquote_list(array(Val) elts) +{ + Val acc = List(({ })); + for(int i=sizeof(elts)-1; 0<=i; i-=1) + { + Val elt = elts[i]; + if(starts_with(elt, "splice-unquote")) + acc = List(({ Symbol("concat"), elt.data[1], acc })); + else + acc = List(({ Symbol("cons"), quasiquote(elt), acc })); + } + return acc; } Val quasiquote(Val ast) { - if(!is_pair(ast)) return List(({ Symbol("quote"), ast })); - Val ast0 = ast.data[0]; - if(ast0.mal_type == MALTYPE_SYMBOL && ast0.value == "unquote") return ast.data[1]; - if(is_pair(ast0) && ast0.data[0].mal_type == MALTYPE_SYMBOL && ast0.data[0].value == "splice-unquote") + switch(ast.mal_type) { - return List(({ Symbol("concat"), ast0.data[1], quasiquote(ast.rest()) })); + case MALTYPE_LIST: + if(starts_with(ast, "unquote")) + return ast.data[1]; + else + return quasiquote_list(ast.data); + case MALTYPE_VECTOR: + return List(({ Symbol("vec"), quasiquote_list(ast.data) })); + case MALTYPE_SYMBOL: + case MALTYPE_MAP: + return List(({ Symbol("quote"), ast })); + default: + return ast; } - return List(({ Symbol("cons"), quasiquote(ast0), quasiquote(ast.rest()) })); } Val eval_ast(Val ast, Env env) @@ -71,6 +95,8 @@ Val EVAL(Val ast, Env env) continue; // TCO case "quote": return ast.data[1]; + case "quasiquoteexpand": + return quasiquote(ast.data[1]); case "quasiquote": ast = quasiquote(ast.data[1]); continue; // TCO diff --git a/impls/pike/step8_macros.pike b/impls/pike/step8_macros.pike index bc4d3cac..4e051d45 100644 --- a/impls/pike/step8_macros.pike +++ b/impls/pike/step8_macros.pike @@ -9,21 +9,45 @@ Val READ(string str) return read_str(str); } -bool is_pair(Val e) +bool starts_with(Val ast, string sym) { - return e.is_sequence && !e.emptyp(); + return ast.mal_type == MALTYPE_LIST && + !ast.emptyp() && + ast.data[0].mal_type == MALTYPE_SYMBOL && + ast.data[0].value == sym; +} + +Val quasiquote_list(array(Val) elts) +{ + Val acc = List(({ })); + for(int i=sizeof(elts)-1; 0<=i; i-=1) + { + Val elt = elts[i]; + if(starts_with(elt, "splice-unquote")) + acc = List(({ Symbol("concat"), elt.data[1], acc })); + else + acc = List(({ Symbol("cons"), quasiquote(elt), acc })); + } + return acc; } Val quasiquote(Val ast) { - if(!is_pair(ast)) return List(({ Symbol("quote"), ast })); - Val ast0 = ast.data[0]; - if(ast0.mal_type == MALTYPE_SYMBOL && ast0.value == "unquote") return ast.data[1]; - if(is_pair(ast0) && ast0.data[0].mal_type == MALTYPE_SYMBOL && ast0.data[0].value == "splice-unquote") + switch(ast.mal_type) { - return List(({ Symbol("concat"), ast0.data[1], quasiquote(ast.rest()) })); + case MALTYPE_LIST: + if(starts_with(ast, "unquote")) + return ast.data[1]; + else + return quasiquote_list(ast.data); + case MALTYPE_VECTOR: + return List(({ Symbol("vec"), quasiquote_list(ast.data) })); + case MALTYPE_SYMBOL: + case MALTYPE_MAP: + return List(({ Symbol("quote"), ast })); + default: + return ast; } - return List(({ Symbol("cons"), quasiquote(ast0), quasiquote(ast.rest()) })); } bool is_macro_call(Val ast, Env env) @@ -96,6 +120,8 @@ Val EVAL(Val ast, Env env) continue; // TCO case "quote": return ast.data[1]; + case "quasiquoteexpand": + return quasiquote(ast.data[1]); case "quasiquote": ast = quasiquote(ast.data[1]); continue; // TCO diff --git a/impls/pike/step9_try.pike b/impls/pike/step9_try.pike index 8a7f04fe..63d6bd9d 100644 --- a/impls/pike/step9_try.pike +++ b/impls/pike/step9_try.pike @@ -9,21 +9,45 @@ Val READ(string str) return read_str(str); } -bool is_pair(Val e) +bool starts_with(Val ast, string sym) { - return e.is_sequence && !e.emptyp(); + return ast.mal_type == MALTYPE_LIST && + !ast.emptyp() && + ast.data[0].mal_type == MALTYPE_SYMBOL && + ast.data[0].value == sym; +} + +Val quasiquote_list(array(Val) elts) +{ + Val acc = List(({ })); + for(int i=sizeof(elts)-1; 0<=i; i-=1) + { + Val elt = elts[i]; + if(starts_with(elt, "splice-unquote")) + acc = List(({ Symbol("concat"), elt.data[1], acc })); + else + acc = List(({ Symbol("cons"), quasiquote(elt), acc })); + } + return acc; } Val quasiquote(Val ast) { - if(!is_pair(ast)) return List(({ Symbol("quote"), ast })); - Val ast0 = ast.data[0]; - if(ast0.mal_type == MALTYPE_SYMBOL && ast0.value == "unquote") return ast.data[1]; - if(is_pair(ast0) && ast0.data[0].mal_type == MALTYPE_SYMBOL && ast0.data[0].value == "splice-unquote") + switch(ast.mal_type) { - return List(({ Symbol("concat"), ast0.data[1], quasiquote(ast.rest()) })); + case MALTYPE_LIST: + if(starts_with(ast, "unquote")) + return ast.data[1]; + else + return quasiquote_list(ast.data); + case MALTYPE_VECTOR: + return List(({ Symbol("vec"), quasiquote_list(ast.data) })); + case MALTYPE_SYMBOL: + case MALTYPE_MAP: + return List(({ Symbol("quote"), ast })); + default: + return ast; } - return List(({ Symbol("cons"), quasiquote(ast0), quasiquote(ast.rest()) })); } bool is_macro_call(Val ast, Env env) @@ -96,6 +120,8 @@ Val EVAL(Val ast, Env env) continue; // TCO case "quote": return ast.data[1]; + case "quasiquoteexpand": + return quasiquote(ast.data[1]); case "quasiquote": ast = quasiquote(ast.data[1]); continue; // TCO diff --git a/impls/pike/stepA_mal.pike b/impls/pike/stepA_mal.pike index e14c3bfb..f2a9c64a 100644 --- a/impls/pike/stepA_mal.pike +++ b/impls/pike/stepA_mal.pike @@ -9,21 +9,45 @@ Val READ(string str) return read_str(str); } -bool is_pair(Val e) +bool starts_with(Val ast, string sym) { - return e.is_sequence && !e.emptyp(); + return ast.mal_type == MALTYPE_LIST && + !ast.emptyp() && + ast.data[0].mal_type == MALTYPE_SYMBOL && + ast.data[0].value == sym; +} + +Val quasiquote_list(array(Val) elts) +{ + Val acc = List(({ })); + for(int i=sizeof(elts)-1; 0<=i; i-=1) + { + Val elt = elts[i]; + if(starts_with(elt, "splice-unquote")) + acc = List(({ Symbol("concat"), elt.data[1], acc })); + else + acc = List(({ Symbol("cons"), quasiquote(elt), acc })); + } + return acc; } Val quasiquote(Val ast) { - if(!is_pair(ast)) return List(({ Symbol("quote"), ast })); - Val ast0 = ast.data[0]; - if(ast0.mal_type == MALTYPE_SYMBOL && ast0.value == "unquote") return ast.data[1]; - if(is_pair(ast0) && ast0.data[0].mal_type == MALTYPE_SYMBOL && ast0.data[0].value == "splice-unquote") + switch(ast.mal_type) { - return List(({ Symbol("concat"), ast0.data[1], quasiquote(ast.rest()) })); + case MALTYPE_LIST: + if(starts_with(ast, "unquote")) + return ast.data[1]; + else + return quasiquote_list(ast.data); + case MALTYPE_VECTOR: + return List(({ Symbol("vec"), quasiquote_list(ast.data) })); + case MALTYPE_SYMBOL: + case MALTYPE_MAP: + return List(({ Symbol("quote"), ast })); + default: + return ast; } - return List(({ Symbol("cons"), quasiquote(ast0), quasiquote(ast.rest()) })); } bool is_macro_call(Val ast, Env env) @@ -96,6 +120,8 @@ Val EVAL(Val ast, Env env) continue; // TCO case "quote": return ast.data[1]; + case "quasiquoteexpand": + return quasiquote(ast.data[1]); case "quasiquote": ast = quasiquote(ast.data[1]); continue; // TCO diff --git a/impls/plpgsql/core.sql b/impls/plpgsql/core.sql index 9e694913..eb9f0b71 100644 --- a/impls/plpgsql/core.sql +++ b/impls/plpgsql/core.sql @@ -317,6 +317,15 @@ BEGIN RETURN types._list(result); END; $$ LANGUAGE plpgsql; +CREATE FUNCTION core.vec(args integer[]) RETURNS integer AS $$ +BEGIN + IF types._vector_Q(args[1]) THEN + RETURN args[1]; + ELSE + RETURN types._vector(types._valueToArray(args[1])); + END IF; +END; $$ LANGUAGE plpgsql; + CREATE FUNCTION core.nth(args integer[]) RETURNS integer AS $$ DECLARE idx integer; @@ -553,6 +562,7 @@ INSERT INTO envs.env (env_id, outer_id, data) 'sequential?', types._function('core.sequential_Q'), 'cons', types._function('core.cons'), 'concat', types._function('core.concat'), + 'vec', types._function('core.vec'), 'nth', types._function('core.nth'), 'first', types._function('core.first'), 'rest', types._function('core.rest'), diff --git a/impls/plpgsql/step7_quote.sql b/impls/plpgsql/step7_quote.sql index bfcb90e1..3bd6e913 100644 --- a/impls/plpgsql/step7_quote.sql +++ b/impls/plpgsql/step7_quote.sql @@ -20,35 +20,61 @@ BEGIN END; $$ LANGUAGE plpgsql; -- eval -CREATE FUNCTION mal.is_pair(ast integer) RETURNS boolean AS $$ + +CREATE FUNCTION mal.qq_loop(elt integer, acc integer) RETURNS integer AS $$ +DECLARE + a0 integer; BEGIN - RETURN types._sequential_Q(ast) AND types._count(ast) > 0; + IF types._list_Q(elt) AND types._count(elt) = 2 THEN + a0 := types._first(elt); + IF types._symbol_Q(a0) AND a0 = types._symbolv('splice-unquote') THEN + RETURN types._list(ARRAY[types._symbolv('concat'), types._nth(elt, 1), acc]); + END IF; + END IF; + RETURN types._list(ARRAY[types._symbolv('cons'), mal.quasiquote(elt), acc]); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.qq_foldr(xs integer) RETURNS integer AS $$ +DECLARE + elt integer; + acc integer := types._list(ARRAY[]::integer[]); +BEGIN + FOREACH elt IN ARRAY types.array_reverse(types._valueToArray(xs)) LOOP + acc := mal.qq_loop(elt, acc); + END LOOP; + RETURN acc; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.quasiquote(ast integer) RETURNS integer AS $$ DECLARE + type integer; a0 integer; - a00 integer; BEGIN - IF NOT mal.is_pair(ast) THEN - RETURN types._list(ARRAY[types._symbolv('quote'), ast]); - ELSE - a0 := types._nth(ast, 0); - IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN - RETURN types._nth(ast, 1); - ELSE - a00 := types._nth(a0, 0); - IF types._symbol_Q(a00) AND - a00 = types._symbolv('splice-unquote') THEN - RETURN types._list(ARRAY[types._symbolv('concat'), - types._nth(a0, 1), - mal.quasiquote(types._rest(ast))]); + SELECT type_id INTO type FROM types.value WHERE value_id = ast; + CASE + WHEN type = 8 THEN -- list + BEGIN + IF types._count(ast) = 2 THEN + a0 := types._first(ast); + IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN + RETURN types._nth(ast, 1); END IF; END IF; - RETURN types._list(ARRAY[types._symbolv('cons'), - mal.quasiquote(types._first(ast)), - mal.quasiquote(types._rest(ast))]); - END IF; + RETURN mal.qq_foldr(ast); + END; + WHEN type = 9 THEN -- vector + BEGIN + RETURN types._list(ARRAY[types._symbolv('vec'), mal.qq_foldr(ast)]); + END; + WHEN type in (7, 10) THEN -- symbol or map + BEGIN + RETURN types._list(ARRAY[types._symbolv('quote'), ast]); + END; + ELSE + BEGIN + RETURN ast; + END; + END CASE; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.eval_ast(ast integer, env integer) RETURNS integer AS $$ @@ -161,6 +187,8 @@ BEGIN BEGIN RETURN types._nth(ast, 1); END; + WHEN a0sym = 'quasiquoteexpand' THEN + RETURN mal.quasiquote(types._nth(ast, 1)); WHEN a0sym = 'quasiquote' THEN BEGIN ast := mal.quasiquote(types._nth(ast, 1)); diff --git a/impls/plpgsql/step8_macros.sql b/impls/plpgsql/step8_macros.sql index ef426f47..c5a5d110 100644 --- a/impls/plpgsql/step8_macros.sql +++ b/impls/plpgsql/step8_macros.sql @@ -20,35 +20,61 @@ BEGIN END; $$ LANGUAGE plpgsql; -- eval -CREATE FUNCTION mal.is_pair(ast integer) RETURNS boolean AS $$ + +CREATE FUNCTION mal.qq_loop(elt integer, acc integer) RETURNS integer AS $$ +DECLARE + a0 integer; BEGIN - RETURN types._sequential_Q(ast) AND types._count(ast) > 0; + IF types._list_Q(elt) AND types._count(elt) = 2 THEN + a0 := types._first(elt); + IF types._symbol_Q(a0) AND a0 = types._symbolv('splice-unquote') THEN + RETURN types._list(ARRAY[types._symbolv('concat'), types._nth(elt, 1), acc]); + END IF; + END IF; + RETURN types._list(ARRAY[types._symbolv('cons'), mal.quasiquote(elt), acc]); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.qq_foldr(xs integer) RETURNS integer AS $$ +DECLARE + elt integer; + acc integer := types._list(ARRAY[]::integer[]); +BEGIN + FOREACH elt IN ARRAY types.array_reverse(types._valueToArray(xs)) LOOP + acc := mal.qq_loop(elt, acc); + END LOOP; + RETURN acc; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.quasiquote(ast integer) RETURNS integer AS $$ DECLARE + type integer; a0 integer; - a00 integer; BEGIN - IF NOT mal.is_pair(ast) THEN - RETURN types._list(ARRAY[types._symbolv('quote'), ast]); - ELSE - a0 := types._nth(ast, 0); - IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN - RETURN types._nth(ast, 1); - ELSE - a00 := types._nth(a0, 0); - IF types._symbol_Q(a00) AND - a00 = types._symbolv('splice-unquote') THEN - RETURN types._list(ARRAY[types._symbolv('concat'), - types._nth(a0, 1), - mal.quasiquote(types._rest(ast))]); + SELECT type_id INTO type FROM types.value WHERE value_id = ast; + CASE + WHEN type = 8 THEN -- list + BEGIN + IF types._count(ast) = 2 THEN + a0 := types._first(ast); + IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN + RETURN types._nth(ast, 1); END IF; END IF; - RETURN types._list(ARRAY[types._symbolv('cons'), - mal.quasiquote(types._first(ast)), - mal.quasiquote(types._rest(ast))]); - END IF; + RETURN mal.qq_foldr(ast); + END; + WHEN type = 9 THEN -- vector + BEGIN + RETURN types._list(ARRAY[types._symbolv('vec'), mal.qq_foldr(ast)]); + END; + WHEN type in (7, 10) THEN -- symbol or map + BEGIN + RETURN types._list(ARRAY[types._symbolv('quote'), ast]); + END; + ELSE + BEGIN + RETURN ast; + END; + END CASE; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.is_macro_call(ast integer, env integer) RETURNS boolean AS $$ @@ -196,6 +222,8 @@ BEGIN BEGIN RETURN types._nth(ast, 1); END; + WHEN a0sym = 'quasiquoteexpand' THEN + RETURN mal.quasiquote(types._nth(ast, 1)); WHEN a0sym = 'quasiquote' THEN BEGIN ast := mal.quasiquote(types._nth(ast, 1)); diff --git a/impls/plpgsql/step9_try.sql b/impls/plpgsql/step9_try.sql index 7070f6d5..b4dce3a5 100644 --- a/impls/plpgsql/step9_try.sql +++ b/impls/plpgsql/step9_try.sql @@ -20,35 +20,61 @@ BEGIN END; $$ LANGUAGE plpgsql; -- eval -CREATE FUNCTION mal.is_pair(ast integer) RETURNS boolean AS $$ + +CREATE FUNCTION mal.qq_loop(elt integer, acc integer) RETURNS integer AS $$ +DECLARE + a0 integer; BEGIN - RETURN types._sequential_Q(ast) AND types._count(ast) > 0; + IF types._list_Q(elt) AND types._count(elt) = 2 THEN + a0 := types._first(elt); + IF types._symbol_Q(a0) AND a0 = types._symbolv('splice-unquote') THEN + RETURN types._list(ARRAY[types._symbolv('concat'), types._nth(elt, 1), acc]); + END IF; + END IF; + RETURN types._list(ARRAY[types._symbolv('cons'), mal.quasiquote(elt), acc]); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.qq_foldr(xs integer) RETURNS integer AS $$ +DECLARE + elt integer; + acc integer := types._list(ARRAY[]::integer[]); +BEGIN + FOREACH elt IN ARRAY types.array_reverse(types._valueToArray(xs)) LOOP + acc := mal.qq_loop(elt, acc); + END LOOP; + RETURN acc; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.quasiquote(ast integer) RETURNS integer AS $$ DECLARE + type integer; a0 integer; - a00 integer; BEGIN - IF NOT mal.is_pair(ast) THEN - RETURN types._list(ARRAY[types._symbolv('quote'), ast]); - ELSE - a0 := types._nth(ast, 0); - IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN - RETURN types._nth(ast, 1); - ELSE - a00 := types._nth(a0, 0); - IF types._symbol_Q(a00) AND - a00 = types._symbolv('splice-unquote') THEN - RETURN types._list(ARRAY[types._symbolv('concat'), - types._nth(a0, 1), - mal.quasiquote(types._rest(ast))]); + SELECT type_id INTO type FROM types.value WHERE value_id = ast; + CASE + WHEN type = 8 THEN -- list + BEGIN + IF types._count(ast) = 2 THEN + a0 := types._first(ast); + IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN + RETURN types._nth(ast, 1); END IF; END IF; - RETURN types._list(ARRAY[types._symbolv('cons'), - mal.quasiquote(types._first(ast)), - mal.quasiquote(types._rest(ast))]); - END IF; + RETURN mal.qq_foldr(ast); + END; + WHEN type = 9 THEN -- vector + BEGIN + RETURN types._list(ARRAY[types._symbolv('vec'), mal.qq_foldr(ast)]); + END; + WHEN type in (7, 10) THEN -- symbol or map + BEGIN + RETURN types._list(ARRAY[types._symbolv('quote'), ast]); + END; + ELSE + BEGIN + RETURN ast; + END; + END CASE; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.is_macro_call(ast integer, env integer) RETURNS boolean AS $$ @@ -198,6 +224,8 @@ BEGIN BEGIN RETURN types._nth(ast, 1); END; + WHEN a0sym = 'quasiquoteexpand' THEN + RETURN mal.quasiquote(types._nth(ast, 1)); WHEN a0sym = 'quasiquote' THEN BEGIN ast := mal.quasiquote(types._nth(ast, 1)); diff --git a/impls/plpgsql/stepA_mal.sql b/impls/plpgsql/stepA_mal.sql index 6880a1b4..fc1e5938 100644 --- a/impls/plpgsql/stepA_mal.sql +++ b/impls/plpgsql/stepA_mal.sql @@ -20,35 +20,61 @@ BEGIN END; $$ LANGUAGE plpgsql; -- eval -CREATE FUNCTION mal.is_pair(ast integer) RETURNS boolean AS $$ + +CREATE FUNCTION mal.qq_loop(elt integer, acc integer) RETURNS integer AS $$ +DECLARE + a0 integer; BEGIN - RETURN types._sequential_Q(ast) AND types._count(ast) > 0; + IF types._list_Q(elt) AND types._count(elt) = 2 THEN + a0 := types._first(elt); + IF types._symbol_Q(a0) AND a0 = types._symbolv('splice-unquote') THEN + RETURN types._list(ARRAY[types._symbolv('concat'), types._nth(elt, 1), acc]); + END IF; + END IF; + RETURN types._list(ARRAY[types._symbolv('cons'), mal.quasiquote(elt), acc]); +END; $$ LANGUAGE plpgsql; + +CREATE FUNCTION mal.qq_foldr(xs integer) RETURNS integer AS $$ +DECLARE + elt integer; + acc integer := types._list(ARRAY[]::integer[]); +BEGIN + FOREACH elt IN ARRAY types.array_reverse(types._valueToArray(xs)) LOOP + acc := mal.qq_loop(elt, acc); + END LOOP; + RETURN acc; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.quasiquote(ast integer) RETURNS integer AS $$ DECLARE + type integer; a0 integer; - a00 integer; BEGIN - IF NOT mal.is_pair(ast) THEN - RETURN types._list(ARRAY[types._symbolv('quote'), ast]); - ELSE - a0 := types._nth(ast, 0); - IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN - RETURN types._nth(ast, 1); - ELSE - a00 := types._nth(a0, 0); - IF types._symbol_Q(a00) AND - a00 = types._symbolv('splice-unquote') THEN - RETURN types._list(ARRAY[types._symbolv('concat'), - types._nth(a0, 1), - mal.quasiquote(types._rest(ast))]); + SELECT type_id INTO type FROM types.value WHERE value_id = ast; + CASE + WHEN type = 8 THEN -- list + BEGIN + IF types._count(ast) = 2 THEN + a0 := types._first(ast); + IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN + RETURN types._nth(ast, 1); END IF; END IF; - RETURN types._list(ARRAY[types._symbolv('cons'), - mal.quasiquote(types._first(ast)), - mal.quasiquote(types._rest(ast))]); - END IF; + RETURN mal.qq_foldr(ast); + END; + WHEN type = 9 THEN -- vector + BEGIN + RETURN types._list(ARRAY[types._symbolv('vec'), mal.qq_foldr(ast)]); + END; + WHEN type in (7, 10) THEN -- symbol or map + BEGIN + RETURN types._list(ARRAY[types._symbolv('quote'), ast]); + END; + ELSE + BEGIN + RETURN ast; + END; + END CASE; END; $$ LANGUAGE plpgsql; CREATE FUNCTION mal.is_macro_call(ast integer, env integer) RETURNS boolean AS $$ @@ -198,6 +224,8 @@ BEGIN BEGIN RETURN types._nth(ast, 1); END; + WHEN a0sym = 'quasiquoteexpand' THEN + RETURN mal.quasiquote(types._nth(ast, 1)); WHEN a0sym = 'quasiquote' THEN BEGIN ast := mal.quasiquote(types._nth(ast, 1)); diff --git a/impls/plsql/core.sql b/impls/plsql/core.sql index 1d4ad1f6..02cf30f8 100644 --- a/impls/plsql/core.sql +++ b/impls/plsql/core.sql @@ -322,6 +322,20 @@ BEGIN RETURN types.seq(M, 8, new_items); END; +FUNCTION vec(M IN OUT NOCOPY types.mal_table, + seq integer) RETURN integer IS +BEGIN + type_id := M(seq).type_id; + CASE + WHEN type_id = 8 THEN + RETURN types.seq(M, 9, TREAT(M(seq) AS mal_seq_T).val_seq); + WHEN type_id = 9 THEN + RETURN seq; + ELSE + raise_application_error(-20009, + 'vec: not supported on type ' || type_id, TRUE); + END CASE; +END; FUNCTION nth(M IN OUT NOCOPY types.mal_table, val integer, @@ -518,6 +532,7 @@ BEGIN WHEN fname = 'sequential?' THEN RETURN types.tf(M(a(1)).type_id IN (8,9)); WHEN fname = 'cons' THEN RETURN cons(M, a); WHEN fname = 'concat' THEN RETURN concat(M, a); + WHEN fname = 'vec' THEN RETURN vec(M, a(1)); WHEN fname = 'nth' THEN RETURN nth(M, a(1), a(2)); WHEN fname = 'first' THEN RETURN first(M, a(1)); WHEN fname = 'rest' THEN RETURN rest(M, a(1)); @@ -590,6 +605,7 @@ BEGIN 'sequential?', 'cons', 'concat', + 'vec', 'nth', 'first', 'rest', diff --git a/impls/plsql/step7_quote.sql b/impls/plsql/step7_quote.sql index e2f90f06..98b5c80a 100644 --- a/impls/plsql/step7_quote.sql +++ b/impls/plsql/step7_quote.sql @@ -37,37 +37,49 @@ FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer; - FUNCTION is_pair(ast integer) RETURN BOOLEAN IS + FUNCTION starts_with(lst integer, sym varchar) RETURNS BOOLEAN IS + a0 integer; BEGIN - RETURN M(ast).type_id IN (8,9) AND types.count(M, ast) > 0; + IF TREAT(M(lst) AS mal_seq_T).val_seq.COUNT = 2 THEN + a0 := types.nth(M, ast, 0) + RETURN M(a0).type_id = 7 AND TREAT(M(a0) AS mal_str_T).val_str = sym; + END IF; + RETURN FALSE; END; - FUNCTION quasiquote(ast integer) RETURN integer IS - a0 integer; - a00 integer; + FUNCTION qq_loop(elt integer, acc integer) RETURNS integer IS BEGIN - IF NOT is_pair(ast) THEN - RETURN types.list(M, types.symbol(M, 'quote'), ast); - ELSE - a0 := types.nth(M, ast, 0); - IF M(a0).type_id = 7 AND - TREAT(m(a0) AS mal_str_T).val_str = 'unquote' THEN - RETURN types.nth(M, ast, 1); - ELSIF is_pair(a0) THEN - a00 := types.nth(M, a0, 0); - IF M(a00).type_id = 7 AND - TREAT(M(a00) AS mal_str_T).val_str = 'splice-unquote' THEN - RETURN types.list(M, types.symbol(M, 'concat'), - types.nth(M, a0, 1), - quasiquote(types.slice(M, ast, 1))); - END IF; - END IF; - RETURN types.list(M, types.symbol(M, 'cons'), - quasiquote(a0), - quasiquote(types.slice(M, ast, 1))); + IF M(elt).type_id = 8 AND starts_with(elt, 'splice-unquote') THEN + RETURN types._list(M, types.symbol('concat'), types.nth(M, a0, 1), acc); END IF; + RETURN types.list(M, types.symbol('cons'), quasiquote(elt), acc); END; + FUNCTION qq_foldr(xs integer[]) RETURNS integer IS + acc integer := types.list(M); + BEGIN + FOR i IN REVERSE 0 .. types._count(xs) - 1 LOOP + acc := qq_loop(types.nth(M, xs, i), acc); + END LOOP; + RETURN acc; + END; + + FUNCTION quasiquote(ast integer) RETURNS integer IS + BEGIN + CASE + WHEN M(ast).type_id IN (7, 10) THEN + RETURN types.list(M, types.symbol('quote'), ast); + WHEN M(ast).type_id = 9 THEN + RETURN types._list(types.symbol('vec'), qq_folr(ast)); + WHEN M(ast).type_id /= 8 THEN + RETURN ast; + WHEN starts_with(ast, 'unquote') THEN + RETURN types.nth(M, ast, 1); + ELSE + RETURN qq_foldr(ast); + END CASE; + END; $$ LANGUAGE plpgsql; + FUNCTION eval_ast(ast integer, env integer) RETURN integer IS i integer; old_seq mal_vals; @@ -151,6 +163,8 @@ FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS ast := types.nth(M, ast, 2); -- TCO WHEN a0sym = 'quote' THEN RETURN types.nth(M, ast, 1); + WHEN a0sym = 'quasiquoteexpand' THEN + RETURN quasiquote(types.nth(M, ast, 1)); WHEN a0sym = 'quasiquote' THEN RETURN EVAL(quasiquote(types.nth(M, ast, 1)), env); WHEN a0sym = 'do' THEN diff --git a/impls/plsql/step8_macros.sql b/impls/plsql/step8_macros.sql index 089ad44e..ff77f1ff 100644 --- a/impls/plsql/step8_macros.sql +++ b/impls/plsql/step8_macros.sql @@ -37,37 +37,48 @@ FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer; - FUNCTION is_pair(ast integer) RETURN BOOLEAN IS + FUNCTION starts_with(lst integer, sym varchar) RETURNS BOOLEAN IS + a0 integer; BEGIN - RETURN M(ast).type_id IN (8,9) AND types.count(M, ast) > 0; - END; - - FUNCTION quasiquote(ast integer) RETURN integer IS - a0 integer; - a00 integer; - BEGIN - IF NOT is_pair(ast) THEN - RETURN types.list(M, types.symbol(M, 'quote'), ast); - ELSE - a0 := types.nth(M, ast, 0); - IF M(a0).type_id = 7 AND - TREAT(m(a0) AS mal_str_T).val_str = 'unquote' THEN - RETURN types.nth(M, ast, 1); - ELSIF is_pair(a0) THEN - a00 := types.nth(M, a0, 0); - IF M(a00).type_id = 7 AND - TREAT(M(a00) AS mal_str_T).val_str = 'splice-unquote' THEN - RETURN types.list(M, types.symbol(M, 'concat'), - types.nth(M, a0, 1), - quasiquote(types.slice(M, ast, 1))); - END IF; - END IF; - RETURN types.list(M, types.symbol(M, 'cons'), - quasiquote(a0), - quasiquote(types.slice(M, ast, 1))); + IF TREAT(M(lst) AS mal_seq_T).val_seq.COUNT = 2 THEN + a0 := types.nth(M, ast, 0) + RETURN M(a0).type_id = 7 AND TREAT(M(a0) AS mal_str_T).val_str = sym; END IF; + RETURN FALSE; END; + FUNCTION qq_loop(elt integer, acc integer) RETURNS integer IS + BEGIN + IF M(elt).type_id = 8 AND starts_with(elt, 'splice-unquote') THEN + RETURN types._list(M, types.symbol('concat'), types.nth(M, a0, 1), acc); + END IF; + RETURN types.list(M, types.symbol('cons'), quasiquote(elt), acc); + END; + + FUNCTION qq_foldr(xs integer[]) RETURNS integer IS + acc integer := types.list(M); + BEGIN + FOR i IN REVERSE 0 .. types._count(xs) - 1 LOOP + acc := qq_loop(types.nth(M, xs, i), acc); + END LOOP; + RETURN acc; + END; + + FUNCTION quasiquote(ast integer) RETURNS integer IS + BEGIN + CASE + WHEN M(ast).type_id IN (7, 10) THEN + RETURN types.list(M, types.symbol('quote'), ast); + WHEN M(ast).type_id = 9 THEN + RETURN types._list(types.symbol('vec'), qq_folr(ast)); + WHEN M(ast).type_id /= 8 THEN + RETURN ast; + WHEN starts_with(ast, 'unquote') THEN + RETURN types.nth(M, ast, 1); + ELSE + RETURN qq_foldr(ast); + END CASE; + END; $$ LANGUAGE plpgsql; FUNCTION is_macro_call(ast integer, env integer) RETURN BOOLEAN IS a0 integer; @@ -199,6 +210,8 @@ FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS ast := types.nth(M, ast, 2); -- TCO WHEN a0sym = 'quote' THEN RETURN types.nth(M, ast, 1); + WHEN a0sym = 'quasiquoteexpand' THEN + RETURN quasiquote(types.nth(M, ast, 1)); WHEN a0sym = 'quasiquote' THEN RETURN EVAL(quasiquote(types.nth(M, ast, 1)), env); WHEN a0sym = 'defmacro!' THEN diff --git a/impls/plsql/step9_try.sql b/impls/plsql/step9_try.sql index aacb2594..29c948a4 100644 --- a/impls/plsql/step9_try.sql +++ b/impls/plsql/step9_try.sql @@ -38,37 +38,48 @@ FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer; - FUNCTION is_pair(ast integer) RETURN BOOLEAN IS + FUNCTION starts_with(lst integer, sym varchar) RETURNS BOOLEAN IS + a0 integer; BEGIN - RETURN M(ast).type_id IN (8,9) AND types.count(M, ast) > 0; - END; - - FUNCTION quasiquote(ast integer) RETURN integer IS - a0 integer; - a00 integer; - BEGIN - IF NOT is_pair(ast) THEN - RETURN types.list(M, types.symbol(M, 'quote'), ast); - ELSE - a0 := types.nth(M, ast, 0); - IF M(a0).type_id = 7 AND - TREAT(m(a0) AS mal_str_T).val_str = 'unquote' THEN - RETURN types.nth(M, ast, 1); - ELSIF is_pair(a0) THEN - a00 := types.nth(M, a0, 0); - IF M(a00).type_id = 7 AND - TREAT(M(a00) AS mal_str_T).val_str = 'splice-unquote' THEN - RETURN types.list(M, types.symbol(M, 'concat'), - types.nth(M, a0, 1), - quasiquote(types.slice(M, ast, 1))); - END IF; - END IF; - RETURN types.list(M, types.symbol(M, 'cons'), - quasiquote(a0), - quasiquote(types.slice(M, ast, 1))); + IF TREAT(M(lst) AS mal_seq_T).val_seq.COUNT = 2 THEN + a0 := types.nth(M, ast, 0) + RETURN M(a0).type_id = 7 AND TREAT(M(a0) AS mal_str_T).val_str = sym; END IF; + RETURN FALSE; END; + FUNCTION qq_loop(elt integer, acc integer) RETURNS integer IS + BEGIN + IF M(elt).type_id = 8 AND starts_with(elt, 'splice-unquote') THEN + RETURN types._list(M, types.symbol('concat'), types.nth(M, a0, 1), acc); + END IF; + RETURN types.list(M, types.symbol('cons'), quasiquote(elt), acc); + END; + + FUNCTION qq_foldr(xs integer[]) RETURNS integer IS + acc integer := types.list(M); + BEGIN + FOR i IN REVERSE 0 .. types._count(xs) - 1 LOOP + acc := qq_loop(types.nth(M, xs, i), acc); + END LOOP; + RETURN acc; + END; + + FUNCTION quasiquote(ast integer) RETURNS integer IS + BEGIN + CASE + WHEN M(ast).type_id IN (7, 10) THEN + RETURN types.list(M, types.symbol('quote'), ast); + WHEN M(ast).type_id = 9 THEN + RETURN types._list(types.symbol('vec'), qq_folr(ast)); + WHEN M(ast).type_id /= 8 THEN + RETURN ast; + WHEN starts_with(ast, 'unquote') THEN + RETURN types.nth(M, ast, 1); + ELSE + RETURN qq_foldr(ast); + END CASE; + END; $$ LANGUAGE plpgsql; FUNCTION is_macro_call(ast integer, env integer) RETURN BOOLEAN IS a0 integer; @@ -201,6 +212,8 @@ FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS ast := types.nth(M, ast, 2); -- TCO WHEN a0sym = 'quote' THEN RETURN types.nth(M, ast, 1); + WHEN a0sym = 'quasiquoteexpand' THEN + RETURN quasiquote(types.nth(M, ast, 1)); WHEN a0sym = 'quasiquote' THEN RETURN EVAL(quasiquote(types.nth(M, ast, 1)), env); WHEN a0sym = 'defmacro!' THEN diff --git a/impls/plsql/stepA_mal.sql b/impls/plsql/stepA_mal.sql index 32be98ef..dd07c15b 100644 --- a/impls/plsql/stepA_mal.sql +++ b/impls/plsql/stepA_mal.sql @@ -38,37 +38,48 @@ FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer; - FUNCTION is_pair(ast integer) RETURN BOOLEAN IS + FUNCTION starts_with(lst integer, sym varchar) RETURNS BOOLEAN IS + a0 integer; BEGIN - RETURN M(ast).type_id IN (8,9) AND types.count(M, ast) > 0; - END; - - FUNCTION quasiquote(ast integer) RETURN integer IS - a0 integer; - a00 integer; - BEGIN - IF NOT is_pair(ast) THEN - RETURN types.list(M, types.symbol(M, 'quote'), ast); - ELSE - a0 := types.nth(M, ast, 0); - IF M(a0).type_id = 7 AND - TREAT(m(a0) AS mal_str_T).val_str = 'unquote' THEN - RETURN types.nth(M, ast, 1); - ELSIF is_pair(a0) THEN - a00 := types.nth(M, a0, 0); - IF M(a00).type_id = 7 AND - TREAT(M(a00) AS mal_str_T).val_str = 'splice-unquote' THEN - RETURN types.list(M, types.symbol(M, 'concat'), - types.nth(M, a0, 1), - quasiquote(types.slice(M, ast, 1))); - END IF; - END IF; - RETURN types.list(M, types.symbol(M, 'cons'), - quasiquote(a0), - quasiquote(types.slice(M, ast, 1))); + IF TREAT(M(lst) AS mal_seq_T).val_seq.COUNT = 2 THEN + a0 := types.nth(M, ast, 0) + RETURN M(a0).type_id = 7 AND TREAT(M(a0) AS mal_str_T).val_str = sym; END IF; + RETURN FALSE; END; + FUNCTION qq_loop(elt integer, acc integer) RETURNS integer IS + BEGIN + IF M(elt).type_id = 8 AND starts_with(elt, 'splice-unquote') THEN + RETURN types._list(M, types.symbol('concat'), types.nth(M, a0, 1), acc); + END IF; + RETURN types.list(M, types.symbol('cons'), quasiquote(elt), acc); + END; + + FUNCTION qq_foldr(xs integer[]) RETURNS integer IS + acc integer := types.list(M); + BEGIN + FOR i IN REVERSE 0 .. types._count(xs) - 1 LOOP + acc := qq_loop(types.nth(M, xs, i), acc); + END LOOP; + RETURN acc; + END; + + FUNCTION quasiquote(ast integer) RETURNS integer IS + BEGIN + CASE + WHEN M(ast).type_id IN (7, 10) THEN + RETURN types.list(M, types.symbol('quote'), ast); + WHEN M(ast).type_id = 9 THEN + RETURN types._list(types.symbol('vec'), qq_folr(ast)); + WHEN M(ast).type_id /= 8 THEN + RETURN ast; + WHEN starts_with(ast, 'unquote') THEN + RETURN types.nth(M, ast, 1); + ELSE + RETURN qq_foldr(ast); + END CASE; + END; $$ LANGUAGE plpgsql; FUNCTION is_macro_call(ast integer, env integer) RETURN BOOLEAN IS a0 integer; @@ -201,6 +212,8 @@ FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS ast := types.nth(M, ast, 2); -- TCO WHEN a0sym = 'quote' THEN RETURN types.nth(M, ast, 1); + WHEN a0sym = 'quasiquoteexpand' THEN + RETURN quasiquote(types.nth(M, ast, 1)); WHEN a0sym = 'quasiquote' THEN RETURN EVAL(quasiquote(types.nth(M, ast, 1)), env); WHEN a0sym = 'defmacro!' THEN diff --git a/impls/powershell/core.psm1 b/impls/powershell/core.psm1 index 2c64dcdb..a8321824 100644 --- a/impls/powershell/core.psm1 +++ b/impls/powershell/core.psm1 @@ -19,6 +19,14 @@ function concat { new-list $res } +function vec($seq) { + if(vector? $seq) { + return $seq + } else { + return new-vector($seq.values) + } +} + function nth($lst, $idx) { if ($idx -ge $lst.values.Count) { throw "nth: index out of range" @@ -147,6 +155,7 @@ $core_ns = @{ "sequential?" = Get-Command sequential?; "cons" = { param($a, $b); new-list (@($a) + $b.values) }; "concat" = Get-Command concat; + "vec" = Get-Command vec; "nth" = Get-Command nth; "first" = { param($a); if ($a -eq $null) { $null } else { $a.first() } }; "rest" = { param($a); if ($a -eq $null) { new-list @() } else { $a.rest() } }; diff --git a/impls/powershell/step7_quote.ps1 b/impls/powershell/step7_quote.ps1 index f515095f..3d21d98a 100644 --- a/impls/powershell/step7_quote.ps1 +++ b/impls/powershell/step7_quote.ps1 @@ -12,28 +12,39 @@ function READ([String] $str) { } # EVAL -function pair?($ast) { - (sequential? $ast) -and $ast.values.Count -gt 0 +function starts_with($lst, $sym) { + if ($lst.values.Count -ne 2) { return $false } + $a0 = $lst.nth(0) + return (symbol? $a0) -and ($a0.value -ceq $sym) } - -function quasiquote($ast) { - if (-not (pair? $ast)) { - return (new-list @((new-symbol "quote"), $ast)) +function qq_loop($elt, $acc) { + if ((list? $elt) -and (starts_with $elt "splice-unquote")) { + return (new-list @((new-symbol "concat"), $elt.nth(1), $acc)) } else { - $a0 = $ast.nth(0) - if ((symbol? $a0) -and $a0.value -ceq "unquote") { - return $ast.nth(1) - } elseif (pair? $a0) { - $a00 = $a0.nth(0) - if ((symbol? $a00) -and $a00.value -ceq "splice-unquote") { - return (new-list @((new-symbol "concat"), - $a0.nth(1), - (quasiquote $ast.rest()))) + return (new-list @((new-symbol "cons"), (quasiquote $elt), $acc)) + } +} +function qq_foldr($xs) { + $acc = new-list @() + for ( $i = $xs.Count - 1; $i -ge 0; $i-- ) { + $acc = qq_loop $xs[$i] $acc + } + return $acc +} +function quasiquote($ast) { + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return (new-list @((new-symbol "quote"), $ast)) } + "HashMap" { return (new-list @((new-symbol "quote"), $ast)) } + "Vector" { return (new-list @((new-symbol "vec"), (qq_foldr $ast.values))) } + "List" { + if (starts_with $ast "unquote") { + return $ast.values[1] + } else { + return qq_foldr $ast.values } } - return (new-list @((new-symbol "cons"), - (quasiquote $a0), - (quasiquote $ast.rest()))) + default { return $ast } } } @@ -78,6 +89,9 @@ function EVAL($ast, $env) { "quote" { return $a1 } + "quasiquoteexpand" { + return (quasiquote $a1) + } "quasiquote" { $ast = quasiquote $a1 } diff --git a/impls/powershell/step8_macros.ps1 b/impls/powershell/step8_macros.ps1 index bbfe0f47..a352636a 100644 --- a/impls/powershell/step8_macros.ps1 +++ b/impls/powershell/step8_macros.ps1 @@ -12,28 +12,39 @@ function READ([String] $str) { } # EVAL -function pair?($ast) { - (sequential? $ast) -and $ast.values.Count -gt 0 +function starts_with($lst, $sym) { + if ($lst.values.Count -ne 2) { return $false } + $a0 = $lst.nth(0) + return (symbol? $a0) -and ($a0.value -ceq $sym) } - -function quasiquote($ast) { - if (-not (pair? $ast)) { - return (new-list @((new-symbol "quote"), $ast)) +function qq_loop($elt, $acc) { + if ((list? $elt) -and (starts_with $elt "splice-unquote")) { + return (new-list @((new-symbol "concat"), $elt.nth(1), $acc)) } else { - $a0 = $ast.nth(0) - if ((symbol? $a0) -and $a0.value -ceq "unquote") { - return $ast.nth(1) - } elseif (pair? $a0) { - $a00 = $a0.nth(0) - if ((symbol? $a00) -and $a00.value -ceq "splice-unquote") { - return (new-list @((new-symbol "concat"), - $a0.nth(1), - (quasiquote $ast.rest()))) + return (new-list @((new-symbol "cons"), (quasiquote $elt), $acc)) + } +} +function qq_foldr($xs) { + $acc = new-list @() + for ( $i = $xs.Count - 1; $i -ge 0; $i-- ) { + $acc = qq_loop $xs[$i] $acc + } + return $acc +} +function quasiquote($ast) { + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return (new-list @((new-symbol "quote"), $ast)) } + "HashMap" { return (new-list @((new-symbol "quote"), $ast)) } + "Vector" { return (new-list @((new-symbol "vec"), (qq_foldr $ast.values))) } + "List" { + if (starts_with $ast "unquote") { + return $ast.values[1] + } else { + return qq_foldr $ast.values } } - return (new-list @((new-symbol "cons"), - (quasiquote $a0), - (quasiquote $ast.rest()))) + default { return $ast } } } @@ -99,6 +110,9 @@ function EVAL($ast, $env) { "quote" { return $a1 } + "quasiquoteexpand" { + return (quasiquote $a1) + } "quasiquote" { $ast = quasiquote $a1 } diff --git a/impls/powershell/step9_try.ps1 b/impls/powershell/step9_try.ps1 index d12e4619..43956880 100644 --- a/impls/powershell/step9_try.ps1 +++ b/impls/powershell/step9_try.ps1 @@ -12,28 +12,39 @@ function READ([String] $str) { } # EVAL -function pair?($ast) { - (sequential? $ast) -and $ast.values.Count -gt 0 +function starts_with($lst, $sym) { + if ($lst.values.Count -ne 2) { return $false } + $a0 = $lst.nth(0) + return (symbol? $a0) -and ($a0.value -ceq $sym) } - -function quasiquote($ast) { - if (-not (pair? $ast)) { - return (new-list @((new-symbol "quote"), $ast)) +function qq_loop($elt, $acc) { + if ((list? $elt) -and (starts_with $elt "splice-unquote")) { + return (new-list @((new-symbol "concat"), $elt.nth(1), $acc)) } else { - $a0 = $ast.nth(0) - if ((symbol? $a0) -and $a0.value -ceq "unquote") { - return $ast.nth(1) - } elseif (pair? $a0) { - $a00 = $a0.nth(0) - if ((symbol? $a00) -and $a00.value -ceq "splice-unquote") { - return (new-list @((new-symbol "concat"), - $a0.nth(1), - (quasiquote $ast.rest()))) + return (new-list @((new-symbol "cons"), (quasiquote $elt), $acc)) + } +} +function qq_foldr($xs) { + $acc = new-list @() + for ( $i = $xs.Count - 1; $i -ge 0; $i-- ) { + $acc = qq_loop $xs[$i] $acc + } + return $acc +} +function quasiquote($ast) { + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return (new-list @((new-symbol "quote"), $ast)) } + "HashMap" { return (new-list @((new-symbol "quote"), $ast)) } + "Vector" { return (new-list @((new-symbol "vec"), (qq_foldr $ast.values))) } + "List" { + if (starts_with $ast "unquote") { + return $ast.values[1] + } else { + return qq_foldr $ast.values } } - return (new-list @((new-symbol "cons"), - (quasiquote $a0), - (quasiquote $ast.rest()))) + default { return $ast } } } @@ -99,6 +110,9 @@ function EVAL($ast, $env) { "quote" { return $a1 } + "quasiquoteexpand" { + return (quasiquote $a1) + } "quasiquote" { $ast = quasiquote $a1 } diff --git a/impls/powershell/stepA_mal.ps1 b/impls/powershell/stepA_mal.ps1 index 25c07e26..24a9846d 100644 --- a/impls/powershell/stepA_mal.ps1 +++ b/impls/powershell/stepA_mal.ps1 @@ -12,28 +12,39 @@ function READ([String] $str) { } # EVAL -function pair?($ast) { - (sequential? $ast) -and $ast.values.Count -gt 0 +function starts_with($lst, $sym) { + if ($lst.values.Count -ne 2) { return $false } + $a0 = $lst.nth(0) + return (symbol? $a0) -and ($a0.value -ceq $sym) } - -function quasiquote($ast) { - if (-not (pair? $ast)) { - return (new-list @((new-symbol "quote"), $ast)) +function qq_loop($elt, $acc) { + if ((list? $elt) -and (starts_with $elt "splice-unquote")) { + return (new-list @((new-symbol "concat"), $elt.nth(1), $acc)) } else { - $a0 = $ast.nth(0) - if ((symbol? $a0) -and $a0.value -ceq "unquote") { - return $ast.nth(1) - } elseif (pair? $a0) { - $a00 = $a0.nth(0) - if ((symbol? $a00) -and $a00.value -ceq "splice-unquote") { - return (new-list @((new-symbol "concat"), - $a0.nth(1), - (quasiquote $ast.rest()))) + return (new-list @((new-symbol "cons"), (quasiquote $elt), $acc)) + } +} +function qq_foldr($xs) { + $acc = new-list @() + for ( $i = $xs.Count - 1; $i -ge 0; $i-- ) { + $acc = qq_loop $xs[$i] $acc + } + return $acc +} +function quasiquote($ast) { + if ($ast -eq $null) { return $ast } + switch ($ast.GetType().Name) { + "Symbol" { return (new-list @((new-symbol "quote"), $ast)) } + "HashMap" { return (new-list @((new-symbol "quote"), $ast)) } + "Vector" { return (new-list @((new-symbol "vec"), (qq_foldr $ast.values))) } + "List" { + if (starts_with $ast "unquote") { + return $ast.values[1] + } else { + return qq_foldr $ast.values } } - return (new-list @((new-symbol "cons"), - (quasiquote $a0), - (quasiquote $ast.rest()))) + default { return $ast } } } @@ -99,6 +110,9 @@ function EVAL($ast, $env) { "quote" { return $a1 } + "quasiquoteexpand" { + return (quasiquote $a1) + } "quasiquote" { $ast = quasiquote $a1 } diff --git a/impls/ps/core.ps b/impls/ps/core.ps index 9854a388..2554110e 100644 --- a/impls/ps/core.ps +++ b/impls/ps/core.ps @@ -324,6 +324,7 @@ end } def (sequential?) { 0 _nth _sequential? } (cons) { cons } (concat) { do_concat } + (vec) { 0 _nth /data get _vector_from_array } (nth) { nth } (first) { first } (rest) { rest } diff --git a/impls/ps/step7_quote.ps b/impls/ps/step7_quote.ps index 02c85be1..c26c7887 100644 --- a/impls/ps/step7_quote.ps +++ b/impls/ps/step7_quote.ps @@ -15,31 +15,50 @@ % eval -% is_pair?: ast -> is_pair? -> bool -% return true if non-empty list, otherwise false -/is_pair? { - dup _sequential? { _count 0 gt }{ pop false } ifelse +% sym ast -> starts_with -> bool +/starts_with { + dup _list? { + 0 _nth + eq + }{ + pop pop false + } ifelse } def % ast -> quasiquote -> new_ast /quasiquote { 3 dict begin /ast exch def - ast is_pair? not { %if not is_pair? + ast _sequential? not { + ast _symbol? ast _hash_map? or { /quote ast 2 _list - }{ - /a0 ast 0 _nth def - a0 /unquote eq { %if a0 unquote symbol + }{ + ast + } ifelse + }{ + /unquote ast starts_with { ast 1 _nth - }{ a0 is_pair? { %elseif a0 is_pair? - /a00 a0 0 _nth def - a00 /splice-unquote eq { %if splice-unquote - /concat a0 1 _nth ast _rest quasiquote 3 _list - }{ %else not splice-unquote - /cons a0 quasiquote ast _rest quasiquote 3 _list + }{ + /res 0 _list def + ast /data get aload length { % reverse traversal + /elt exch def + /res + /splice-unquote elt starts_with { + /concat + elt 1 _nth + }{ + /cons + elt quasiquote + } ifelse + res + 3 _list + def + } repeat + ast _list? { + res + }{ + /vec res 2 _list } ifelse - }{ % else not a0 is_pair? - /cons a0 quasiquote ast _rest quasiquote 3 _list - } ifelse } ifelse + } ifelse } ifelse end } def @@ -101,6 +120,8 @@ end } def /loop? true def % loop }{ /quote a0 eq { %if quote ast 1 _nth + }{ /quasiquoteexpand a0 eq {%if quasiquoteexpand + ast 1 _nth quasiquote }{ /quasiquote a0 eq { %if quasiquote ast 1 _nth quasiquote env @@ -141,7 +162,7 @@ end } def }{ %else (regular procedure/function) (cannot apply native proc!\n) print quit } ifelse } ifelse - } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse + } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse loop? not { exit } if diff --git a/impls/ps/step8_macros.ps b/impls/ps/step8_macros.ps index 45a681d6..f6fe0290 100644 --- a/impls/ps/step8_macros.ps +++ b/impls/ps/step8_macros.ps @@ -15,31 +15,50 @@ % eval -% is_pair?: ast -> is_pair? -> bool -% return true if non-empty list, otherwise false -/is_pair? { - dup _sequential? { _count 0 gt }{ pop false } ifelse +% sym ast -> starts_with -> bool +/starts_with { + dup _list? { + 0 _nth + eq + }{ + pop pop false + } ifelse } def % ast -> quasiquote -> new_ast /quasiquote { 3 dict begin /ast exch def - ast is_pair? not { %if not is_pair? + ast _sequential? not { + ast _symbol? ast _hash_map? or { /quote ast 2 _list - }{ - /a0 ast 0 _nth def - a0 /unquote eq { %if a0 unquote symbol + }{ + ast + } ifelse + }{ + /unquote ast starts_with { ast 1 _nth - }{ a0 is_pair? { %elseif a0 is_pair? - /a00 a0 0 _nth def - a00 /splice-unquote eq { %if splice-unquote - /concat a0 1 _nth ast _rest quasiquote 3 _list - }{ %else not splice-unquote - /cons a0 quasiquote ast _rest quasiquote 3 _list + }{ + /res 0 _list def + ast /data get aload length { % reverse traversal + /elt exch def + /res + /splice-unquote elt starts_with { + /concat + elt 1 _nth + }{ + /cons + elt quasiquote + } ifelse + res + 3 _list + def + } repeat + ast _list? { + res + }{ + /vec res 2 _list } ifelse - }{ % else not a0 is_pair? - /cons a0 quasiquote ast _rest quasiquote 3 _list - } ifelse } ifelse + } ifelse } ifelse end } def @@ -134,6 +153,8 @@ end } def /loop? true def % loop }{ /quote a0 eq { %if quote ast 1 _nth + }{ /quasiquoteexpand a0 eq {%if quasiquoteexpand + ast 1 _nth quasiquote }{ /quasiquote a0 eq { %if quasiquote ast 1 _nth quasiquote env @@ -182,7 +203,7 @@ end } def }{ %else (regular procedure/function) (cannot apply native proc!\n) print quit } ifelse } ifelse - } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse + } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse diff --git a/impls/ps/step9_try.ps b/impls/ps/step9_try.ps index f778ab7e..9cca137d 100644 --- a/impls/ps/step9_try.ps +++ b/impls/ps/step9_try.ps @@ -15,31 +15,50 @@ % eval -% is_pair?: ast -> is_pair? -> bool -% return true if non-empty list, otherwise false -/is_pair? { - dup _sequential? { _count 0 gt }{ pop false } ifelse +% sym ast -> starts_with -> bool +/starts_with { + dup _list? { + 0 _nth + eq + }{ + pop pop false + } ifelse } def % ast -> quasiquote -> new_ast /quasiquote { 3 dict begin /ast exch def - ast is_pair? not { %if not is_pair? + ast _sequential? not { + ast _symbol? ast _hash_map? or { /quote ast 2 _list - }{ - /a0 ast 0 _nth def - a0 /unquote eq { %if a0 unquote symbol + }{ + ast + } ifelse + }{ + /unquote ast starts_with { ast 1 _nth - }{ a0 is_pair? { %elseif a0 is_pair? - /a00 a0 0 _nth def - a00 /splice-unquote eq { %if splice-unquote - /concat a0 1 _nth ast _rest quasiquote 3 _list - }{ %else not splice-unquote - /cons a0 quasiquote ast _rest quasiquote 3 _list + }{ + /res 0 _list def + ast /data get aload length { % reverse traversal + /elt exch def + /res + /splice-unquote elt starts_with { + /concat + elt 1 _nth + }{ + /cons + elt quasiquote + } ifelse + res + 3 _list + def + } repeat + ast _list? { + res + }{ + /vec res 2 _list } ifelse - }{ % else not a0 is_pair? - /cons a0 quasiquote ast _rest quasiquote 3 _list - } ifelse } ifelse + } ifelse } ifelse end } def @@ -134,6 +153,8 @@ end } def /loop? true def % loop }{ /quote a0 eq { %if quote ast 1 _nth + }{ /quasiquoteexpand a0 eq {%if quasiquoteexpand + ast 1 _nth quasiquote }{ /quasiquote a0 eq { %if quasiquote ast 1 _nth quasiquote env @@ -225,7 +246,7 @@ end } def }{ %else (regular procedure/function) (cannot apply native proc!\n) print quit } ifelse } ifelse - } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse + } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse diff --git a/impls/ps/stepA_mal.ps b/impls/ps/stepA_mal.ps index 98b83343..21be2f1b 100644 --- a/impls/ps/stepA_mal.ps +++ b/impls/ps/stepA_mal.ps @@ -15,31 +15,50 @@ % eval -% is_pair?: ast -> is_pair? -> bool -% return true if non-empty list, otherwise false -/is_pair? { - dup _sequential? { _count 0 gt }{ pop false } ifelse +% sym ast -> starts_with -> bool +/starts_with { + dup _list? { + 0 _nth + eq + }{ + pop pop false + } ifelse } def % ast -> quasiquote -> new_ast /quasiquote { 3 dict begin /ast exch def - ast is_pair? not { %if not is_pair? + ast _sequential? not { + ast _symbol? ast _hash_map? or { /quote ast 2 _list - }{ - /a0 ast 0 _nth def - a0 /unquote eq { %if a0 unquote symbol + }{ + ast + } ifelse + }{ + /unquote ast starts_with { ast 1 _nth - }{ a0 is_pair? { %elseif a0 is_pair? - /a00 a0 0 _nth def - a00 /splice-unquote eq { %if splice-unquote - /concat a0 1 _nth ast _rest quasiquote 3 _list - }{ %else not splice-unquote - /cons a0 quasiquote ast _rest quasiquote 3 _list + }{ + /res 0 _list def + ast /data get aload length { % reverse traversal + /elt exch def + /res + /splice-unquote elt starts_with { + /concat + elt 1 _nth + }{ + /cons + elt quasiquote + } ifelse + res + 3 _list + def + } repeat + ast _list? { + res + }{ + /vec res 2 _list } ifelse - }{ % else not a0 is_pair? - /cons a0 quasiquote ast _rest quasiquote 3 _list - } ifelse } ifelse + } ifelse } ifelse end } def @@ -134,6 +153,8 @@ end } def /loop? true def % loop }{ /quote a0 eq { %if quote ast 1 _nth + }{ /quasiquoteexpand a0 eq {%if quasiquoteexpand + ast 1 _nth quasiquote }{ /quasiquote a0 eq { %if quasiquote ast 1 _nth quasiquote env @@ -234,7 +255,7 @@ end } def }{ %else (regular procedure/function) (cannot apply native proc!\n) print quit } ifelse } ifelse - } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse + } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse diff --git a/impls/python.2/core.py b/impls/python.2/core.py index 3cfaa37f..2bb1cb05 100644 --- a/impls/python.2/core.py +++ b/impls/python.2/core.py @@ -126,6 +126,11 @@ def reset(atom: MalExpression, val: MalExpression) -> MalExpression: return val +def vec(arg: MalExpression) -> MalExpression: + assert isinstance(arg, MalList) or isinstance(arg, MalVector) + return MalVector(arg.native ()) + + def cons(first: MalExpression, rest: MalExpression) -> MalExpression: assert isinstance(rest, MalList) or isinstance(rest, MalVector) return MalList([first] + rest.native()) @@ -381,6 +386,7 @@ ns = { "atom?": MalFunctionCompiled(lambda args: MalBoolean(isinstance(args[0], MalAtom))), "deref": MalFunctionCompiled(lambda args: deref_q(args[0])), "reset!": MalFunctionCompiled(lambda args: reset(args[0], args[1])), + "vec": MalFunctionCompiled(lambda args: vec(args[0])), "cons": MalFunctionCompiled(lambda args: cons(args[0], args[1])), "concat": MalFunctionCompiled(concat), "not": MalFunctionCompiled(lambda args: not_(args[0])), diff --git a/impls/python.2/step7_quote.py b/impls/python.2/step7_quote.py index ded42348..ad293715 100644 --- a/impls/python.2/step7_quote.py +++ b/impls/python.2/step7_quote.py @@ -1,3 +1,4 @@ +import functools import readline import sys from typing import List, Dict @@ -48,7 +49,6 @@ def swap(args: List[MalExpression]) -> MalExpression: def READ(x: str) -> MalExpression: return reader.read(x) - def eval_ast(ast: MalExpression, env: Env) -> MalExpression: if isinstance(ast, MalSymbol): return env.get(ast) @@ -64,38 +64,32 @@ def eval_ast(ast: MalExpression, env: Env) -> MalExpression: return ast -def is_pair(x: MalExpression) -> bool: - if (isinstance(x, MalList) or isinstance(x, MalVector)) and len(x.native()) > 0: - return True - return False +def qq_loop(acc: MalList, elt: MalExpression) -> MalList: + if isinstance(elt, MalList): + lst = elt.native() + if len(lst) == 2: + fst = lst[0] + if isinstance(fst, MalSymbol) and fst.native() == u"splice-unquote": + return MalList([MalSymbol(u"concat"), lst[1], acc]) + return MalList([MalSymbol(u"cons"), quasiquote(elt), acc]) +def qq_foldr(xs: List[MalExpression]) -> MalList: + return functools.reduce(qq_loop, reversed(xs), MalList([])) def quasiquote(ast: MalExpression) -> MalExpression: - if not is_pair(ast): + if isinstance(ast, MalList): + lst = ast.native() + if len(lst) == 2: + fst = lst[0] + if isinstance(fst, MalSymbol) and fst.native() == u'unquote': + return lst[1] + return qq_foldr(lst) + elif isinstance(ast, MalVector): + return MalList([MalSymbol("vec"), qq_foldr(ast.native())]) + elif isinstance(ast, MalSymbol) or isinstance(ast, MalHash_map): return MalList([MalSymbol("quote"), ast]) - elif core.equal(ast.native()[0], MalSymbol("unquote")).native(): - return ast.native()[1] - elif ( - is_pair(ast.native()[0]) - and core.equal( - ast.native()[0].native()[0], MalSymbol("splice-unquote") - ).native() - ): - return MalList( - [ - MalSymbol("concat"), - ast.native()[0].native()[1], - quasiquote(MalList(ast.native()[1:])), - ] - ) else: - return MalList( - [ - MalSymbol("cons"), - quasiquote(ast.native()[0]), - quasiquote(MalList(ast.native()[1:])), - ] - ) + return ast def EVAL(ast: MalExpression, env: Env) -> MalExpression: @@ -160,6 +154,8 @@ def EVAL(ast: MalExpression, env: Env) -> MalExpression: if isinstance(ast_native[1], MalVector) else ast_native[1] ) + elif first_str == "quasiquoteexpand": + return quasiquote(ast_native[1]) elif first_str == "quasiquote": ast = quasiquote(ast_native[1]) continue diff --git a/impls/python.2/step8_macros.py b/impls/python.2/step8_macros.py index 446fac8f..10bad332 100644 --- a/impls/python.2/step8_macros.py +++ b/impls/python.2/step8_macros.py @@ -1,3 +1,4 @@ +import functools import readline import sys from typing import List, Dict @@ -44,38 +45,32 @@ def eval_ast(ast: MalExpression, env: Env) -> MalExpression: return ast -def is_pair(x: MalExpression) -> bool: - if (isinstance(x, MalList) or isinstance(x, MalVector)) and len(x.native()) > 0: - return True - return False +def qq_loop(acc: MalList, elt: MalExpression) -> MalList: + if isinstance(elt, MalList): + lst = elt.native() + if len(lst) == 2: + fst = lst[0] + if isinstance(fst, MalSymbol) and fst.native() == u"splice-unquote": + return MalList([MalSymbol(u"concat"), lst[1], acc]) + return MalList([MalSymbol(u"cons"), quasiquote(elt), acc]) +def qq_foldr(xs: List[MalExpression]) -> MalList: + return functools.reduce(qq_loop, reversed(xs), MalList([])) def quasiquote(ast: MalExpression) -> MalExpression: - if not is_pair(ast): + if isinstance(ast, MalList): + lst = ast.native() + if len(lst) == 2: + fst = lst[0] + if isinstance(fst, MalSymbol) and fst.native() == u'unquote': + return lst[1] + return qq_foldr(lst) + elif isinstance(ast, MalVector): + return MalList([MalSymbol("vec"), qq_foldr(ast.native())]) + elif isinstance(ast, MalSymbol) or isinstance(ast, MalHash_map): return MalList([MalSymbol("quote"), ast]) - elif core.equal(ast.native()[0], MalSymbol("unquote")).native(): - return ast.native()[1] - elif ( - is_pair(ast.native()[0]) - and core.equal( - ast.native()[0].native()[0], MalSymbol("splice-unquote") - ).native() - ): - return MalList( - [ - MalSymbol("concat"), - ast.native()[0].native()[1], - quasiquote(MalList(ast.native()[1:])), - ] - ) else: - return MalList( - [ - MalSymbol("cons"), - quasiquote(ast.native()[0]), - quasiquote(MalList(ast.native()[1:])), - ] - ) + return ast def EVAL(ast: MalExpression, env: Env) -> MalExpression: @@ -151,6 +146,8 @@ def EVAL(ast: MalExpression, env: Env) -> MalExpression: if isinstance(ast_native[1], MalVector) else ast_native[1] ) + elif first_str == "quasiquoteexpand": + return quasiquote(ast_native[1]) elif first_str == "quasiquote": ast = quasiquote(ast_native[1]) continue diff --git a/impls/python.2/step9_try.py b/impls/python.2/step9_try.py index ee7cca0d..c8ecac23 100644 --- a/impls/python.2/step9_try.py +++ b/impls/python.2/step9_try.py @@ -1,3 +1,4 @@ +import functools import readline import sys from typing import List, Dict @@ -38,38 +39,32 @@ def eval_ast(ast: MalExpression, env: Env) -> MalExpression: return ast -def is_pair(x: MalExpression) -> bool: - if (isinstance(x, MalList) or isinstance(x, MalVector)) and len(x.native()) > 0: - return True - return False +def qq_loop(acc: MalList, elt: MalExpression) -> MalList: + if isinstance(elt, MalList): + lst = elt.native() + if len(lst) == 2: + fst = lst[0] + if isinstance(fst, MalSymbol) and fst.native() == u"splice-unquote": + return MalList([MalSymbol(u"concat"), lst[1], acc]) + return MalList([MalSymbol(u"cons"), quasiquote(elt), acc]) +def qq_foldr(xs: List[MalExpression]) -> MalList: + return functools.reduce(qq_loop, reversed(xs), MalList([])) def quasiquote(ast: MalExpression) -> MalExpression: - if not is_pair(ast): + if isinstance(ast, MalList): + lst = ast.native() + if len(lst) == 2: + fst = lst[0] + if isinstance(fst, MalSymbol) and fst.native() == u'unquote': + return lst[1] + return qq_foldr(lst) + elif isinstance(ast, MalVector): + return MalList([MalSymbol("vec"), qq_foldr(ast.native())]) + elif isinstance(ast, MalSymbol) or isinstance(ast, MalHash_map): return MalList([MalSymbol("quote"), ast]) - elif core.equal(ast.native()[0], MalSymbol("unquote")).native(): - return ast.native()[1] - elif ( - is_pair(ast.native()[0]) - and core.equal( - ast.native()[0].native()[0], MalSymbol("splice-unquote") - ).native() - ): - return MalList( - [ - MalSymbol("concat"), - ast.native()[0].native()[1], - quasiquote(MalList(ast.native()[1:])), - ] - ) else: - return MalList( - [ - MalSymbol("cons"), - quasiquote(ast.native()[0]), - quasiquote(MalList(ast.native()[1:])), - ] - ) + return ast def EVAL(ast: MalExpression, env: Env) -> MalExpression: @@ -145,6 +140,8 @@ def EVAL(ast: MalExpression, env: Env) -> MalExpression: if isinstance(ast_native[1], MalVector) else ast_native[1] ) + elif first_str == "quasiquoteexpand": + return quasiquote(ast_native[1]) elif first_str == "quasiquote": ast = quasiquote(ast_native[1]) continue diff --git a/impls/python.2/stepA_mal.py b/impls/python.2/stepA_mal.py index 6ed2977a..0cbb09f4 100644 --- a/impls/python.2/stepA_mal.py +++ b/impls/python.2/stepA_mal.py @@ -1,3 +1,4 @@ +import functools import readline import sys from typing import List, Dict @@ -41,38 +42,32 @@ def eval_ast(ast: MalExpression, env: Env) -> MalExpression: return ast -def is_pair(x: MalExpression) -> bool: - if (isinstance(x, MalList) or isinstance(x, MalVector)) and len(x.native()) > 0: - return True - return False +def qq_loop(acc: MalList, elt: MalExpression) -> MalList: + if isinstance(elt, MalList): + lst = elt.native() + if len(lst) == 2: + fst = lst[0] + if isinstance(fst, MalSymbol) and fst.native() == u"splice-unquote": + return MalList([MalSymbol(u"concat"), lst[1], acc]) + return MalList([MalSymbol(u"cons"), quasiquote(elt), acc]) +def qq_foldr(xs: List[MalExpression]) -> MalList: + return functools.reduce(qq_loop, reversed(xs), MalList([])) def quasiquote(ast: MalExpression) -> MalExpression: - if not is_pair(ast): + if isinstance(ast, MalList): + lst = ast.native() + if len(lst) == 2: + fst = lst[0] + if isinstance(fst, MalSymbol) and fst.native() == u'unquote': + return lst[1] + return qq_foldr(lst) + elif isinstance(ast, MalVector): + return MalList([MalSymbol("vec"), qq_foldr(ast.native())]) + elif isinstance(ast, MalSymbol) or isinstance(ast, MalHash_map): return MalList([MalSymbol("quote"), ast]) - elif core.equal(ast.native()[0], MalSymbol("unquote")).native(): - return ast.native()[1] - elif ( - is_pair(ast.native()[0]) - and core.equal( - ast.native()[0].native()[0], MalSymbol("splice-unquote") - ).native() - ): - return MalList( - [ - MalSymbol("concat"), - ast.native()[0].native()[1], - quasiquote(MalList(ast.native()[1:])), - ] - ) else: - return MalList( - [ - MalSymbol("cons"), - quasiquote(ast.native()[0]), - quasiquote(MalList(ast.native()[1:])), - ] - ) + return ast def EVAL(ast: MalExpression, env: Env) -> MalExpression: @@ -149,6 +144,8 @@ def EVAL(ast: MalExpression, env: Env) -> MalExpression: if isinstance(ast_native[1], MalVector) else ast_native[1] ) + elif first_str == "quasiquoteexpand": + return quasiquote(ast_native[1]) elif first_str == "quasiquote": ast = quasiquote(ast_native[1]) continue diff --git a/impls/python/core.py b/impls/python/core.py index 414a5a03..cb351b20 100644 --- a/impls/python/core.py +++ b/impls/python/core.py @@ -172,6 +172,7 @@ ns = { 'sequential?': types._sequential_Q, 'cons': cons, 'concat': concat, + 'vec': Vector, 'nth': nth, 'first': first, 'rest': rest, diff --git a/impls/python/step7_quote.py b/impls/python/step7_quote.py index e8b5b8a0..1fd9b1c3 100644 --- a/impls/python/step7_quote.py +++ b/impls/python/step7_quote.py @@ -1,3 +1,4 @@ +import functools import sys, traceback import mal_readline import mal_types as types @@ -10,23 +11,27 @@ def READ(str): return reader.read_str(str) # eval -def is_pair(x): - return types._sequential_Q(x) and len(x) > 0 +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) + else: + 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 not is_pair(ast): - return types._list(types._symbol("quote"), - ast) - elif ast[0] == 'unquote': - return ast[1] - elif is_pair(ast[0]) and ast[0][0] == 'splice-unquote': - return types._list(types._symbol("concat"), - ast[0][1], - quasiquote(ast[1:])) + if types._list_Q(ast): + 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(u'quote'), ast) + elif types._vector_Q (ast): + return types._list(types._symbol(u'vec'), qq_foldr(ast)) else: - return types._list(types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast[1:])) + return ast def eval_ast(ast, env): if types._symbol_Q(ast): @@ -68,6 +73,8 @@ def EVAL(ast, env): # Continue loop (TCO) elif "quote" == a0: return ast[1] + elif "quasiquoteexpand" == a0: + return quasiquote(ast[1]); elif "quasiquote" == a0: ast = quasiquote(ast[1]); # Continue loop (TCO) diff --git a/impls/python/step8_macros.py b/impls/python/step8_macros.py index 3b6f8a68..73095579 100644 --- a/impls/python/step8_macros.py +++ b/impls/python/step8_macros.py @@ -1,3 +1,4 @@ +import functools import sys, traceback import mal_readline import mal_types as types @@ -10,23 +11,27 @@ def READ(str): return reader.read_str(str) # eval -def is_pair(x): - return types._sequential_Q(x) and len(x) > 0 +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) + else: + 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 not is_pair(ast): - return types._list(types._symbol("quote"), - ast) - elif ast[0] == 'unquote': - return ast[1] - elif is_pair(ast[0]) and ast[0][0] == 'splice-unquote': - return types._list(types._symbol("concat"), - ast[0][1], - quasiquote(ast[1:])) + if types._list_Q(ast): + 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(u'quote'), ast) + elif types._vector_Q (ast): + return types._list(types._symbol(u'vec'), qq_foldr(ast)) else: - return types._list(types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast[1:])) + return ast def is_macro_call(ast, env): return (types._list_Q(ast) and @@ -83,6 +88,8 @@ def EVAL(ast, env): # Continue loop (TCO) elif "quote" == a0: return ast[1] + elif "quasiquoteexpand" == a0: + return quasiquote(ast[1]); elif "quasiquote" == a0: ast = quasiquote(ast[1]); # Continue loop (TCO) diff --git a/impls/python/step9_try.py b/impls/python/step9_try.py index 2d148165..09941a34 100644 --- a/impls/python/step9_try.py +++ b/impls/python/step9_try.py @@ -1,3 +1,4 @@ +import functools import sys, traceback import mal_readline import mal_types as types @@ -10,23 +11,27 @@ def READ(str): return reader.read_str(str) # eval -def is_pair(x): - return types._sequential_Q(x) and len(x) > 0 +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) + else: + 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 not is_pair(ast): - return types._list(types._symbol("quote"), - ast) - elif ast[0] == 'unquote': - return ast[1] - elif is_pair(ast[0]) and ast[0][0] == 'splice-unquote': - return types._list(types._symbol("concat"), - ast[0][1], - quasiquote(ast[1:])) + if types._list_Q(ast): + 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(u'quote'), ast) + elif types._vector_Q (ast): + return types._list(types._symbol(u'vec'), qq_foldr(ast)) else: - return types._list(types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast[1:])) + return ast def is_macro_call(ast, env): return (types._list_Q(ast) and @@ -83,6 +88,8 @@ def EVAL(ast, env): # Continue loop (TCO) elif "quote" == a0: return ast[1] + elif "quasiquoteexpand" == a0: + return quasiquote(ast[1]); elif "quasiquote" == a0: ast = quasiquote(ast[1]); # Continue loop (TCO) diff --git a/impls/python/stepA_mal.py b/impls/python/stepA_mal.py index dedca291..f6224fb5 100644 --- a/impls/python/stepA_mal.py +++ b/impls/python/stepA_mal.py @@ -1,3 +1,4 @@ +import functools import sys, traceback import mal_readline import mal_types as types @@ -10,23 +11,27 @@ def READ(str): return reader.read_str(str) # eval -def is_pair(x): - return types._sequential_Q(x) and len(x) > 0 +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) + else: + 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 not is_pair(ast): - return types._list(types._symbol("quote"), - ast) - elif ast[0] == 'unquote': - return ast[1] - elif is_pair(ast[0]) and ast[0][0] == 'splice-unquote': - return types._list(types._symbol("concat"), - ast[0][1], - quasiquote(ast[1:])) + if types._list_Q(ast): + 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(u'quote'), ast) + elif types._vector_Q (ast): + return types._list(types._symbol(u'vec'), qq_foldr(ast)) else: - return types._list(types._symbol("cons"), - quasiquote(ast[0]), - quasiquote(ast[1:])) + return ast def is_macro_call(ast, env): return (types._list_Q(ast) and @@ -83,6 +88,8 @@ def EVAL(ast, env): # Continue loop (TCO) elif "quote" == a0: return ast[1] + elif "quasiquoteexpand" == a0: + return quasiquote(ast[1]); elif "quasiquote" == a0: ast = quasiquote(ast[1]); # Continue loop (TCO) diff --git a/impls/r/core.r b/impls/r/core.r index a14c0740..9a12de3a 100644 --- a/impls/r/core.r +++ b/impls/r/core.r @@ -182,6 +182,7 @@ core_ns <- list( "sequential?"=.sequential_q, "cons"=cons, "concat"=do_concat, + "vec"=new.vectorl, "nth"=nth, "first"=function(a) if (.nil_q(a) || length(a) < 1) nil else a[[1]], "rest"=function(a) if (.nil_q(a)) new.list() else new.listl(slice(a,2)), diff --git a/impls/r/step7_quote.r b/impls/r/step7_quote.r index 4d8719c6..52b68d0d 100644 --- a/impls/r/step7_quote.r +++ b/impls/r/step7_quote.r @@ -11,26 +11,38 @@ READ <- function(str) { } # eval -is_pair <- function(x) { - .sequential_q(x) && length(x) > 0 +starts_with <- function(ast, sym) { + .list_q(ast) && length(ast) == 2 && .symbol_q(ast[[1]]) && ast[[1]] == sym +} + +quasiquote_elements <- function(ast) { + acc <- new.list() + i <- length(ast) + while (0 < i) { + elt <- ast[[i]] + if (starts_with(elt, "splice-unquote")) { + acc = new.list(new.symbol("concat"), elt[[2]], acc) + } else { + acc = new.list(new.symbol("cons"), quasiquote(elt), acc) + } + i <- i-1 + } + acc } quasiquote <- function(ast) { - if (!is_pair(ast)) { - new.list(new.symbol("quote"), - ast) - } else if (.symbol_q(ast[[1]]) && ast[[1]] == "unquote") { - ast[[2]] - } else if (is_pair(ast[[1]]) && - .symbol_q(ast[[1]][[1]]) && - ast[[1]][[1]] == "splice-unquote") { - new.list(new.symbol("concat"), - ast[[1]][[2]], - quasiquote(slice(ast, 2))) + if (.list_q(ast)) { + if (starts_with(ast, "unquote")) { + ast[[2]] + } else { + quasiquote_elements(ast) + } + } else if (.vector_q(ast)) { + new.list(new.symbol("vec"), quasiquote_elements(ast)) + } else if (.symbol_q(ast) || .hash_map_q(ast)) { + new.list(new.symbol("quote"), ast) } else { - new.list(new.symbol("cons"), - quasiquote(ast[[1]]), - quasiquote(slice(ast, 2))) + ast } } @@ -81,6 +93,8 @@ EVAL <- function(ast, env) { env <- let_env } else if (a0sym == "quote") { return(a1) + } else if (a0sym == "quasiquoteexpand") { + return(quasiquote(a1)) } else if (a0sym == "quasiquote") { ast <- quasiquote(a1) } else if (a0sym == "do") { diff --git a/impls/r/step8_macros.r b/impls/r/step8_macros.r index d6ead1ab..c6434a38 100644 --- a/impls/r/step8_macros.r +++ b/impls/r/step8_macros.r @@ -11,26 +11,38 @@ READ <- function(str) { } # eval -is_pair <- function(x) { - .sequential_q(x) && length(x) > 0 +starts_with <- function(ast, sym) { + .list_q(ast) && length(ast) == 2 && .symbol_q(ast[[1]]) && ast[[1]] == sym +} + +quasiquote_elements <- function(ast) { + acc <- new.list() + i <- length(ast) + while (0 < i) { + elt <- ast[[i]] + if (starts_with(elt, "splice-unquote")) { + acc = new.list(new.symbol("concat"), elt[[2]], acc) + } else { + acc = new.list(new.symbol("cons"), quasiquote(elt), acc) + } + i <- i-1 + } + acc } quasiquote <- function(ast) { - if (!is_pair(ast)) { - new.list(new.symbol("quote"), - ast) - } else if (.symbol_q(ast[[1]]) && ast[[1]] == "unquote") { - ast[[2]] - } else if (is_pair(ast[[1]]) && - .symbol_q(ast[[1]][[1]]) && - ast[[1]][[1]] == "splice-unquote") { - new.list(new.symbol("concat"), - ast[[1]][[2]], - quasiquote(slice(ast, 2))) + if (.list_q(ast)) { + if (starts_with(ast, "unquote")) { + ast[[2]] + } else { + quasiquote_elements(ast) + } + } else if (.vector_q(ast)) { + new.list(new.symbol("vec"), quasiquote_elements(ast)) + } else if (.symbol_q(ast) || .hash_map_q(ast)) { + new.list(new.symbol("quote"), ast) } else { - new.list(new.symbol("cons"), - quasiquote(ast[[1]]), - quasiquote(slice(ast, 2))) + ast } } @@ -101,6 +113,8 @@ EVAL <- function(ast, env) { env <- let_env } else if (a0sym == "quote") { return(a1) + } else if (a0sym == "quasiquoteexpand") { + return(quasiquote(a1)) } else if (a0sym == "quasiquote") { ast <- quasiquote(a1) } else if (a0sym == "defmacro!") { diff --git a/impls/r/step9_try.r b/impls/r/step9_try.r index d6d460d3..c1be773a 100644 --- a/impls/r/step9_try.r +++ b/impls/r/step9_try.r @@ -11,26 +11,38 @@ READ <- function(str) { } # eval -is_pair <- function(x) { - .sequential_q(x) && length(x) > 0 +starts_with <- function(ast, sym) { + .list_q(ast) && length(ast) == 2 && .symbol_q(ast[[1]]) && ast[[1]] == sym +} + +quasiquote_elements <- function(ast) { + acc <- new.list() + i <- length(ast) + while (0 < i) { + elt <- ast[[i]] + if (starts_with(elt, "splice-unquote")) { + acc = new.list(new.symbol("concat"), elt[[2]], acc) + } else { + acc = new.list(new.symbol("cons"), quasiquote(elt), acc) + } + i <- i-1 + } + acc } quasiquote <- function(ast) { - if (!is_pair(ast)) { - new.list(new.symbol("quote"), - ast) - } else if (.symbol_q(ast[[1]]) && ast[[1]] == "unquote") { - ast[[2]] - } else if (is_pair(ast[[1]]) && - .symbol_q(ast[[1]][[1]]) && - ast[[1]][[1]] == "splice-unquote") { - new.list(new.symbol("concat"), - ast[[1]][[2]], - quasiquote(slice(ast, 2))) + if (.list_q(ast)) { + if (starts_with(ast, "unquote")) { + ast[[2]] + } else { + quasiquote_elements(ast) + } + } else if (.vector_q(ast)) { + new.list(new.symbol("vec"), quasiquote_elements(ast)) + } else if (.symbol_q(ast) || .hash_map_q(ast)) { + new.list(new.symbol("quote"), ast) } else { - new.list(new.symbol("cons"), - quasiquote(ast[[1]]), - quasiquote(slice(ast, 2))) + ast } } @@ -101,6 +113,8 @@ EVAL <- function(ast, env) { env <- let_env } else if (a0sym == "quote") { return(a1) + } else if (a0sym == "quasiquoteexpand") { + return(quasiquote(a1)) } else if (a0sym == "quasiquote") { ast <- quasiquote(a1) } else if (a0sym == "defmacro!") { diff --git a/impls/r/stepA_mal.r b/impls/r/stepA_mal.r index a73d3270..ca77531c 100644 --- a/impls/r/stepA_mal.r +++ b/impls/r/stepA_mal.r @@ -11,26 +11,38 @@ READ <- function(str) { } # eval -is_pair <- function(x) { - .sequential_q(x) && length(x) > 0 +starts_with <- function(ast, sym) { + .list_q(ast) && length(ast) == 2 && .symbol_q(ast[[1]]) && ast[[1]] == sym +} + +quasiquote_elements <- function(ast) { + acc <- new.list() + i <- length(ast) + while (0 < i) { + elt <- ast[[i]] + if (starts_with(elt, "splice-unquote")) { + acc = new.list(new.symbol("concat"), elt[[2]], acc) + } else { + acc = new.list(new.symbol("cons"), quasiquote(elt), acc) + } + i <- i-1 + } + acc } quasiquote <- function(ast) { - if (!is_pair(ast)) { - new.list(new.symbol("quote"), - ast) - } else if (.symbol_q(ast[[1]]) && ast[[1]] == "unquote") { - ast[[2]] - } else if (is_pair(ast[[1]]) && - .symbol_q(ast[[1]][[1]]) && - ast[[1]][[1]] == "splice-unquote") { - new.list(new.symbol("concat"), - ast[[1]][[2]], - quasiquote(slice(ast, 2))) + if (.list_q(ast)) { + if (starts_with(ast, "unquote")) { + ast[[2]] + } else { + quasiquote_elements(ast) + } + } else if (.vector_q(ast)) { + new.list(new.symbol("vec"), quasiquote_elements(ast)) + } else if (.symbol_q(ast) || .hash_map_q(ast)) { + new.list(new.symbol("quote"), ast) } else { - new.list(new.symbol("cons"), - quasiquote(ast[[1]]), - quasiquote(slice(ast, 2))) + ast } } @@ -101,6 +113,8 @@ EVAL <- function(ast, env) { env <- let_env } else if (a0sym == "quote") { return(a1) + } else if (a0sym == "quasiquoteexpand") { + return(quasiquote(a1)) } else if (a0sym == "quasiquote") { ast <- quasiquote(a1) } else if (a0sym == "defmacro!") { diff --git a/impls/racket/core.rkt b/impls/racket/core.rkt index e7cc53d5..1c69df29 100644 --- a/impls/racket/core.rkt +++ b/impls/racket/core.rkt @@ -102,6 +102,7 @@ 'sequential? _sequential? 'cons (lambda a (cons (first a) (_to_list (second a)))) 'concat (lambda a (apply append (map _to_list a))) + 'vec (lambda a (let* ([x (first a)]) (if (vector? x) x (list->vector x)))) 'nth _nth 'first _first 'rest _rest diff --git a/impls/racket/step7_quote.rkt b/impls/racket/step7_quote.rkt index 9973f25c..3f2610ae 100755 --- a/impls/racket/step7_quote.rkt +++ b/impls/racket/step7_quote.rkt @@ -9,23 +9,28 @@ (read_str str)) ;; eval -(define (is-pair x) - (and (_sequential? x) (> (_count x) 0))) + +(define (qq-loop elt acc) + (if (and (list? elt) (= (length elt) 2) (equal? (car elt) 'splice-unquote)) + (list 'concat (cadr elt) acc) + (list 'cons (quasiquote elt) acc))) (define (quasiquote ast) (cond - [(not (is-pair ast)) + [(or (symbol? ast) (hash? ast)) (list 'quote ast)] - [(equal? 'unquote (_nth ast 0)) - (_nth ast 1)] + [(vector? ast) + (list 'vec (foldr qq-loop null (_to_list ast)))] - [(and (is-pair (_nth ast 0)) - (equal? 'splice-unquote (_nth (_nth ast 0) 0))) - (list 'concat (_nth (_nth ast 0) 1) (quasiquote (_rest ast)))] + [(not (list? ast)) + ast] + + [(and (= (length ast) 2) (equal? (car ast) 'unquote)) + (cadr ast)] [else - (list 'cons (quasiquote (_nth ast 0)) (quasiquote (_rest ast)))])) + (foldr qq-loop null ast)])) (define (eval-ast ast env) (cond @@ -52,6 +57,8 @@ (EVAL (_nth ast 2) let-env))] [(eq? 'quote a0) (_nth ast 1)] + [(eq? 'quasiquoteexpand a0) + (quasiquote (cadr ast))] [(eq? 'quasiquote a0) (EVAL (quasiquote (_nth ast 1)) env)] [(eq? 'do a0) diff --git a/impls/racket/step8_macros.rkt b/impls/racket/step8_macros.rkt index a592637e..ccffa822 100755 --- a/impls/racket/step8_macros.rkt +++ b/impls/racket/step8_macros.rkt @@ -9,23 +9,28 @@ (read_str str)) ;; eval -(define (is-pair x) - (and (_sequential? x) (> (_count x) 0))) + +(define (qq-loop elt acc) + (if (and (list? elt) (= (length elt) 2) (equal? (car elt) 'splice-unquote)) + (list 'concat (cadr elt) acc) + (list 'cons (quasiquote elt) acc))) (define (quasiquote ast) (cond - [(not (is-pair ast)) + [(or (symbol? ast) (hash? ast)) (list 'quote ast)] - [(equal? 'unquote (_nth ast 0)) - (_nth ast 1)] + [(vector? ast) + (list 'vec (foldr qq-loop null (_to_list ast)))] - [(and (is-pair (_nth ast 0)) - (equal? 'splice-unquote (_nth (_nth ast 0) 0))) - (list 'concat (_nth (_nth ast 0) 1) (quasiquote (_rest ast)))] + [(not (list? ast)) + ast] + + [(and (= (length ast) 2) (equal? (car ast) 'unquote)) + (cadr ast)] [else - (list 'cons (quasiquote (_nth ast 0)) (quasiquote (_rest ast)))])) + (foldr qq-loop null ast)])) (define (macro? ast env) (and (list? ast) @@ -69,6 +74,8 @@ (EVAL (_nth ast 2) let-env))] [(eq? 'quote a0) (_nth ast 1)] + [(eq? 'quasiquoteexpand a0) + (quasiquote (cadr ast))] [(eq? 'quasiquote a0) (EVAL (quasiquote (_nth ast 1)) env)] [(eq? 'defmacro! a0) diff --git a/impls/racket/step9_try.rkt b/impls/racket/step9_try.rkt index 49edd060..633fe1c0 100755 --- a/impls/racket/step9_try.rkt +++ b/impls/racket/step9_try.rkt @@ -9,23 +9,28 @@ (read_str str)) ;; eval -(define (is-pair x) - (and (_sequential? x) (> (_count x) 0))) + +(define (qq-loop elt acc) + (if (and (list? elt) (= (length elt) 2) (equal? (car elt) 'splice-unquote)) + (list 'concat (cadr elt) acc) + (list 'cons (quasiquote elt) acc))) (define (quasiquote ast) (cond - [(not (is-pair ast)) + [(or (symbol? ast) (hash? ast)) (list 'quote ast)] - [(equal? 'unquote (_nth ast 0)) - (_nth ast 1)] + [(vector? ast) + (list 'vec (foldr qq-loop null (_to_list ast)))] - [(and (is-pair (_nth ast 0)) - (equal? 'splice-unquote (_nth (_nth ast 0) 0))) - (list 'concat (_nth (_nth ast 0) 1) (quasiquote (_rest ast)))] + [(not (list? ast)) + ast] + + [(and (= (length ast) 2) (equal? (car ast) 'unquote)) + (cadr ast)] [else - (list 'cons (quasiquote (_nth ast 0)) (quasiquote (_rest ast)))])) + (foldr qq-loop null ast)])) (define (macro? ast env) (and (list? ast) @@ -70,6 +75,8 @@ (EVAL (_nth ast 2) let-env))] [(eq? 'quote a0) (_nth ast 1)] + [(eq? 'quasiquoteexpand a0) + (quasiquote (cadr ast))] [(eq? 'quasiquote a0) (EVAL (quasiquote (_nth ast 1)) env)] [(eq? 'defmacro! a0) diff --git a/impls/racket/stepA_mal.rkt b/impls/racket/stepA_mal.rkt index 6a96ca2b..9b68e709 100755 --- a/impls/racket/stepA_mal.rkt +++ b/impls/racket/stepA_mal.rkt @@ -9,23 +9,28 @@ (read_str str)) ;; eval -(define (is-pair x) - (and (_sequential? x) (> (_count x) 0))) + +(define (qq-loop elt acc) + (if (and (list? elt) (= (length elt) 2) (equal? (car elt) 'splice-unquote)) + (list 'concat (cadr elt) acc) + (list 'cons (quasiquote elt) acc))) (define (quasiquote ast) (cond - [(not (is-pair ast)) + [(or (symbol? ast) (hash? ast)) (list 'quote ast)] - [(equal? 'unquote (_nth ast 0)) - (_nth ast 1)] + [(vector? ast) + (list 'vec (foldr qq-loop null (_to_list ast)))] - [(and (is-pair (_nth ast 0)) - (equal? 'splice-unquote (_nth (_nth ast 0) 0))) - (list 'concat (_nth (_nth ast 0) 1) (quasiquote (_rest ast)))] + [(not (list? ast)) + ast] + + [(and (= (length ast) 2) (equal? (car ast) 'unquote)) + (cadr ast)] [else - (list 'cons (quasiquote (_nth ast 0)) (quasiquote (_rest ast)))])) + (foldr qq-loop null ast)])) (define (macro? ast env) (and (list? ast) @@ -70,6 +75,8 @@ (EVAL (_nth ast 2) let-env))] [(eq? 'quote a0) (_nth ast 1)] + [(eq? 'quasiquoteexpand a0) + (quasiquote (cadr ast))] [(eq? 'quasiquote a0) (EVAL (quasiquote (_nth ast 1)) env)] [(eq? 'defmacro! a0) diff --git a/impls/rexx/core.rexx b/impls/rexx/core.rexx index 63fe5551..f92fd221 100644 --- a/impls/rexx/core.rexx +++ b/impls/rexx/core.rexx @@ -253,6 +253,9 @@ mal_concat: procedure expose values. /* mal_concat(...) */ end return new_list(seq) +mal_vec: procedure expose values. /* mal_vec(a) */ + return new_vector(obj_val(arg(1))) + mal_nth: procedure expose values. err /* mal_nth(list, index) */ list_val = obj_val(arg(1)) i = obj_val(arg(2)) @@ -486,6 +489,7 @@ get_core_ns: procedure /* get_core_ns() */ "sequential? mal_sequential?" , "cons mal_cons" , "concat mal_concat" , + "vec mal_vec" , "nth mal_nth" , "first mal_first" , "rest mal_rest" , diff --git a/impls/rexx/step7_quote.rexx b/impls/rexx/step7_quote.rexx index 4b6caa53..6314c4f5 100644 --- a/impls/rexx/step7_quote.rexx +++ b/impls/rexx/step7_quote.rexx @@ -18,20 +18,45 @@ exit read: procedure expose values. err /* read(str) */ return read_str(arg(1)) -pair?: procedure expose values. /* pair?(ast) */ - ast = arg(1) - return sequential?(ast) & words(obj_val(ast)) > 0 +starts_with?: procedure expose values. /* starts_with?(lst, sym) */ + lst = arg(1) + sym = arg(2) + if words(obj_val(lst)) != 2 then return 0 + a0 = word(obj_val(lst), 1) + return symbol?(a0) & obj_val(a0) == sym + +qq_loop: procedure expose values. /* qq_loop(elt, acc) */ + elt = arg(1) + acc = arg(2) + if list?(elt) & starts_with?(elt, "splice-unquote") then + return new_list(new_symbol("concat") || " " || word(obj_val(elt), 2) || " " || acc) + else + return new_list(new_symbol("cons") || " " || quasiquote(elt) || " " || acc) + +qq_foldr: procedure expose values. /* qq_foldr(xs) */ + xs = arg(1) + acc = new_list() + do i=words(xs) to 1 by -1 + acc = qq_loop(word(xs, i), acc) + end + return acc quasiquote: procedure expose values. env. err /* quasiquote(ast) */ ast = arg(1) - if \pair?(ast) then return new_list(new_symbol("quote") || " " || ast) - ast0 = word(obj_val(ast), 1) - if symbol?(ast0) & obj_val(ast0) == "unquote" then return word(obj_val(ast), 2) - ast00 = word(obj_val(ast0), 1) - if pair?(ast0) & symbol?(ast00) & obj_val(ast00) == "splice-unquote" then - return new_list(new_symbol("concat") || " " || word(obj_val(ast0), 2) || " " || quasiquote(mal_rest(ast))) - else - return new_list(new_symbol("cons") || " " || quasiquote(ast0) || " " || quasiquote(mal_rest(ast))) + type = obj_type(ast) + select + when type == "list" then + if starts_with?(ast, "unquote") then + return word(obj_val(ast), 2) + else + return qq_foldr(obj_val(ast)) + when type == "vect" then + return new_list(new_symbol("vec") || " " || qq_foldr(obj_val(ast))) + when type == "symb" | type == "hash" then + return new_list(new_symbol("quote") || " " || ast) + otherwise + return ast + end eval_ast: procedure expose values. env. err /* eval_ast(ast, env_idx) */ ast = arg(1) @@ -109,6 +134,7 @@ eval: procedure expose values. env. err /* eval(ast) */ /* TCO */ end when a0sym == "quote" then return word(astval, 2) + when a0sym == "quasiquoteexpand" then return quasiquote(word(astval, 2)) when a0sym == "quasiquote" then do ast = quasiquote(word(astval, 2)) /* TCO */ diff --git a/impls/rexx/step8_macros.rexx b/impls/rexx/step8_macros.rexx index ed9ffb8d..64562d9b 100644 --- a/impls/rexx/step8_macros.rexx +++ b/impls/rexx/step8_macros.rexx @@ -18,20 +18,45 @@ exit read: procedure expose values. err /* read(str) */ return read_str(arg(1)) -pair?: procedure expose values. /* pair?(ast) */ - ast = arg(1) - return sequential?(ast) & words(obj_val(ast)) > 0 +starts_with?: procedure expose values. /* starts_with?(lst, sym) */ + lst = arg(1) + sym = arg(2) + if words(obj_val(lst)) != 2 then return 0 + a0 = word(obj_val(lst), 1) + return symbol?(a0) & obj_val(a0) == sym + +qq_loop: procedure expose values. /* qq_loop(elt, acc) */ + elt = arg(1) + acc = arg(2) + if list?(elt) & starts_with?(elt, "splice-unquote") then + return new_list(new_symbol("concat") || " " || word(obj_val(elt), 2) || " " || acc) + else + return new_list(new_symbol("cons") || " " || quasiquote(elt) || " " || acc) + +qq_foldr: procedure expose values. /* qq_foldr(xs) */ + xs = arg(1) + acc = new_list() + do i=words(xs) to 1 by -1 + acc = qq_loop(word(xs, i), acc) + end + return acc quasiquote: procedure expose values. env. err /* quasiquote(ast) */ ast = arg(1) - if \pair?(ast) then return new_list(new_symbol("quote") || " " || ast) - ast0 = word(obj_val(ast), 1) - if symbol?(ast0) & obj_val(ast0) == "unquote" then return word(obj_val(ast), 2) - ast00 = word(obj_val(ast0), 1) - if pair?(ast0) & symbol?(ast00) & obj_val(ast00) == "splice-unquote" then - return new_list(new_symbol("concat") || " " || word(obj_val(ast0), 2) || " " || quasiquote(mal_rest(ast))) - else - return new_list(new_symbol("cons") || " " || quasiquote(ast0) || " " || quasiquote(mal_rest(ast))) + type = obj_type(ast) + select + when type == "list" then + if starts_with?(ast, "unquote") then + return word(obj_val(ast), 2) + else + return qq_foldr(obj_val(ast)) + when type == "vect" then + return new_list(new_symbol("vec") || " " || qq_foldr(obj_val(ast))) + when type == "symb" | type == "hash" then + return new_list(new_symbol("quote") || " " || ast) + otherwise + return ast + end macro?: procedure expose values. env. /* macro?(ast, env_idx) */ ast = arg(1) @@ -131,6 +156,7 @@ eval: procedure expose values. env. err /* eval(ast) */ /* TCO */ end when a0sym == "quote" then return word(astval, 2) + when a0sym == "quasiquoteexpand" then return quasiquote(word(astval, 2)) when a0sym == "quasiquote" then do ast = quasiquote(word(astval, 2)) /* TCO */ diff --git a/impls/rexx/step9_try.rexx b/impls/rexx/step9_try.rexx index f0807832..ac115611 100644 --- a/impls/rexx/step9_try.rexx +++ b/impls/rexx/step9_try.rexx @@ -18,20 +18,45 @@ exit read: procedure expose values. err /* read(str) */ return read_str(arg(1)) -pair?: procedure expose values. /* pair?(ast) */ - ast = arg(1) - return sequential?(ast) & words(obj_val(ast)) > 0 +starts_with?: procedure expose values. /* starts_with?(lst, sym) */ + lst = arg(1) + sym = arg(2) + if words(obj_val(lst)) != 2 then return 0 + a0 = word(obj_val(lst), 1) + return symbol?(a0) & obj_val(a0) == sym + +qq_loop: procedure expose values. /* qq_loop(elt, acc) */ + elt = arg(1) + acc = arg(2) + if list?(elt) & starts_with?(elt, "splice-unquote") then + return new_list(new_symbol("concat") || " " || word(obj_val(elt), 2) || " " || acc) + else + return new_list(new_symbol("cons") || " " || quasiquote(elt) || " " || acc) + +qq_foldr: procedure expose values. /* qq_foldr(xs) */ + xs = arg(1) + acc = new_list() + do i=words(xs) to 1 by -1 + acc = qq_loop(word(xs, i), acc) + end + return acc quasiquote: procedure expose values. env. err /* quasiquote(ast) */ ast = arg(1) - if \pair?(ast) then return new_list(new_symbol("quote") || " " || ast) - ast0 = word(obj_val(ast), 1) - if symbol?(ast0) & obj_val(ast0) == "unquote" then return word(obj_val(ast), 2) - ast00 = word(obj_val(ast0), 1) - if pair?(ast0) & symbol?(ast00) & obj_val(ast00) == "splice-unquote" then - return new_list(new_symbol("concat") || " " || word(obj_val(ast0), 2) || " " || quasiquote(mal_rest(ast))) - else - return new_list(new_symbol("cons") || " " || quasiquote(ast0) || " " || quasiquote(mal_rest(ast))) + type = obj_type(ast) + select + when type == "list" then + if starts_with?(ast, "unquote") then + return word(obj_val(ast), 2) + else + return qq_foldr(obj_val(ast)) + when type == "vect" then + return new_list(new_symbol("vec") || " " || qq_foldr(obj_val(ast))) + when type == "symb" | type == "hash" then + return new_list(new_symbol("quote") || " " || ast) + otherwise + return ast + end macro?: procedure expose values. env. /* macro?(ast, env_idx) */ ast = arg(1) @@ -131,6 +156,7 @@ eval: procedure expose values. env. err /* eval(ast) */ /* TCO */ end when a0sym == "quote" then return word(astval, 2) + when a0sym == "quasiquoteexpand" then return quasiquote(word(astval, 2)) when a0sym == "quasiquote" then do ast = quasiquote(word(astval, 2)) /* TCO */ diff --git a/impls/rexx/stepA_mal.rexx b/impls/rexx/stepA_mal.rexx index a3a9d0f7..8dbc6b4b 100644 --- a/impls/rexx/stepA_mal.rexx +++ b/impls/rexx/stepA_mal.rexx @@ -18,20 +18,45 @@ exit read: procedure expose values. err /* read(str) */ return read_str(arg(1)) -pair?: procedure expose values. /* pair?(ast) */ - ast = arg(1) - return sequential?(ast) & words(obj_val(ast)) > 0 +starts_with?: procedure expose values. /* starts_with?(lst, sym) */ + lst = arg(1) + sym = arg(2) + if words(obj_val(lst)) != 2 then return 0 + a0 = word(obj_val(lst), 1) + return symbol?(a0) & obj_val(a0) == sym + +qq_loop: procedure expose values. /* qq_loop(elt, acc) */ + elt = arg(1) + acc = arg(2) + if list?(elt) & starts_with?(elt, "splice-unquote") then + return new_list(new_symbol("concat") || " " || word(obj_val(elt), 2) || " " || acc) + else + return new_list(new_symbol("cons") || " " || quasiquote(elt) || " " || acc) + +qq_foldr: procedure expose values. /* qq_foldr(xs) */ + xs = arg(1) + acc = new_list() + do i=words(xs) to 1 by -1 + acc = qq_loop(word(xs, i), acc) + end + return acc quasiquote: procedure expose values. env. err /* quasiquote(ast) */ ast = arg(1) - if \pair?(ast) then return new_list(new_symbol("quote") || " " || ast) - ast0 = word(obj_val(ast), 1) - if symbol?(ast0) & obj_val(ast0) == "unquote" then return word(obj_val(ast), 2) - ast00 = word(obj_val(ast0), 1) - if pair?(ast0) & symbol?(ast00) & obj_val(ast00) == "splice-unquote" then - return new_list(new_symbol("concat") || " " || word(obj_val(ast0), 2) || " " || quasiquote(mal_rest(ast))) - else - return new_list(new_symbol("cons") || " " || quasiquote(ast0) || " " || quasiquote(mal_rest(ast))) + type = obj_type(ast) + select + when type == "list" then + if starts_with?(ast, "unquote") then + return word(obj_val(ast), 2) + else + return qq_foldr(obj_val(ast)) + when type == "vect" then + return new_list(new_symbol("vec") || " " || qq_foldr(obj_val(ast))) + when type == "symb" | type == "hash" then + return new_list(new_symbol("quote") || " " || ast) + otherwise + return ast + end macro?: procedure expose values. env. /* macro?(ast, env_idx) */ ast = arg(1) @@ -131,6 +156,7 @@ eval: procedure expose values. env. err /* eval(ast) */ /* TCO */ end when a0sym == "quote" then return word(astval, 2) + when a0sym == "quasiquoteexpand" then return quasiquote(word(astval, 2)) when a0sym == "quasiquote" then do ast = quasiquote(word(astval, 2)) /* TCO */ diff --git a/impls/rpython/core.py b/impls/rpython/core.py index 5e7a12fb..6df848b5 100644 --- a/impls/rpython/core.py +++ b/impls/rpython/core.py @@ -232,6 +232,13 @@ def count(args): def sequential_Q(args): return wrap_tf(types._sequential_Q(args[0])) +def vec(args): + seq = args[0] + if isinstance(seq, MalList): + return MalVector(seq.values) + else: + throw_str("vec called on non-sequence") + def cons(args): x, seq = args[0], args[1] if not isinstance(seq, MalList): @@ -413,6 +420,7 @@ ns = { 'vals': vals, 'sequential?': sequential_Q, + 'vec': vec, 'cons': cons, 'concat': concat, 'nth': nth, diff --git a/impls/rpython/step7_quote.py b/impls/rpython/step7_quote.py index 456e8de9..cb8c063a 100644 --- a/impls/rpython/step7_quote.py +++ b/impls/rpython/step7_quote.py @@ -13,28 +13,32 @@ def READ(str): return reader.read_str(str) # eval -def is_pair(x): - return types._sequential_Q(x) and len(x) > 0 +def qq_loop(elt, acc): + if types._list_Q(elt) and len(elt) == 2: + fst = elt[0] + if isinstance(fst, MalSym) and fst.value == u"splice-unquote": + return _list(_symbol(u"concat"), elt[1], acc) + return _list(_symbol(u"cons"), quasiquote(elt), acc) + +def qq_foldr(seq): + acc = _list() + for elt in reversed(seq): + acc = qq_loop (elt, acc) + return acc def quasiquote(ast): - if not is_pair(ast): + if types._list_Q(ast): + if len(ast) == 2: + fst = ast[0] + if isinstance(fst, MalSym) and fst.value == u"unquote": + return ast[1] + return qq_foldr(ast.values) + elif types._vector_Q(ast): + return _list(_symbol(u"vec"), qq_foldr(ast.values)) + elif types._symbol_Q(ast) or types._hash_map_Q(ast): return _list(_symbol(u"quote"), ast) else: - a0 = ast[0] - if isinstance(a0, MalSym): - if a0.value == u'unquote': - return ast[1] - if is_pair(a0) and isinstance(a0[0], MalSym): - a00 = a0[0] - if (isinstance(a00, MalSym) and - a00.value == u'splice-unquote'): - return _list(_symbol(u"concat"), - a0[1], - quasiquote(ast.rest())) - return _list(_symbol(u"cons"), - quasiquote(a0), - quasiquote(ast.rest())) - + return ast def eval_ast(ast, env): if types._symbol_Q(ast): @@ -85,6 +89,8 @@ def EVAL(ast, env): env = let_env # Continue loop (TCO) elif u"quote" == a0sym: return ast[1] + elif u"quasiquoteexpand" == a0sym: + return quasiquote(ast[1]) elif u"quasiquote" == a0sym: ast = quasiquote(ast[1]) # Continue loop (TCO) elif u"do" == a0sym: @@ -110,7 +116,7 @@ def EVAL(ast, env): if isinstance(f, MalFunc): if f.ast: ast = f.ast - env = f.gen_env(el.rest()) # Continue loop (TCO) + env = f.gen_env(el.rest()) # Continue loop (TCO) else: return f.apply(el.rest()) else: diff --git a/impls/rpython/step8_macros.py b/impls/rpython/step8_macros.py index 83cac9fd..8aff32a9 100644 --- a/impls/rpython/step8_macros.py +++ b/impls/rpython/step8_macros.py @@ -13,27 +13,32 @@ def READ(str): return reader.read_str(str) # eval -def is_pair(x): - return types._sequential_Q(x) and len(x) > 0 +def qq_loop(elt, acc): + if types._list_Q(elt) and len(elt) == 2: + fst = elt[0] + if isinstance(fst, MalSym) and fst.value == u"splice-unquote": + return _list(_symbol(u"concat"), elt[1], acc) + return _list(_symbol(u"cons"), quasiquote(elt), acc) + +def qq_foldr(seq): + acc = _list() + for elt in reversed(seq): + acc = qq_loop (elt, acc) + return acc def quasiquote(ast): - if not is_pair(ast): + if types._list_Q(ast): + if len(ast) == 2: + fst = ast[0] + if isinstance(fst, MalSym) and fst.value == u"unquote": + return ast[1] + return qq_foldr(ast.values) + elif types._vector_Q(ast): + return _list(_symbol(u"vec"), qq_foldr(ast.values)) + elif types._symbol_Q(ast) or types._hash_map_Q(ast): return _list(_symbol(u"quote"), ast) else: - a0 = ast[0] - if isinstance(a0, MalSym): - if a0.value == u'unquote': - return ast[1] - if is_pair(a0) and isinstance(a0[0], MalSym): - a00 = a0[0] - if (isinstance(a00, MalSym) and - a00.value == u'splice-unquote'): - return _list(_symbol(u"concat"), - a0[1], - quasiquote(ast.rest())) - return _list(_symbol(u"cons"), - quasiquote(a0), - quasiquote(ast.rest())) + return ast def is_macro_call(ast, env): if types._list_Q(ast): @@ -103,6 +108,8 @@ def EVAL(ast, env): env = let_env # Continue loop (TCO) elif u"quote" == a0sym: return ast[1] + elif u"quasiquoteexpand" == a0sym: + return quasiquote(ast[1]) elif u"quasiquote" == a0sym: ast = quasiquote(ast[1]) # Continue loop (TCO) elif u"defmacro!" == a0sym: @@ -134,7 +141,7 @@ def EVAL(ast, env): if isinstance(f, MalFunc): if f.ast: ast = f.ast - env = f.gen_env(el.rest()) # Continue loop (TCO) + env = f.gen_env(el.rest()) # Continue loop (TCO) else: return f.apply(el.rest()) else: diff --git a/impls/rpython/step9_try.py b/impls/rpython/step9_try.py index c4a273e2..40989a7a 100644 --- a/impls/rpython/step9_try.py +++ b/impls/rpython/step9_try.py @@ -13,27 +13,32 @@ def READ(str): return reader.read_str(str) # eval -def is_pair(x): - return types._sequential_Q(x) and len(x) > 0 +def qq_loop(elt, acc): + if types._list_Q(elt) and len(elt) == 2: + fst = elt[0] + if isinstance(fst, MalSym) and fst.value == u"splice-unquote": + return _list(_symbol(u"concat"), elt[1], acc) + return _list(_symbol(u"cons"), quasiquote(elt), acc) + +def qq_foldr(seq): + acc = _list() + for elt in reversed(seq): + acc = qq_loop (elt, acc) + return acc def quasiquote(ast): - if not is_pair(ast): + if types._list_Q(ast): + if len(ast) == 2: + fst = ast[0] + if isinstance(fst, MalSym) and fst.value == u"unquote": + return ast[1] + return qq_foldr(ast.values) + elif types._vector_Q(ast): + return _list(_symbol(u"vec"), qq_foldr(ast.values)) + elif types._symbol_Q(ast) or types._hash_map_Q(ast): return _list(_symbol(u"quote"), ast) else: - a0 = ast[0] - if isinstance(a0, MalSym): - if a0.value == u'unquote': - return ast[1] - if is_pair(a0) and isinstance(a0[0], MalSym): - a00 = a0[0] - if (isinstance(a00, MalSym) and - a00.value == u'splice-unquote'): - return _list(_symbol(u"concat"), - a0[1], - quasiquote(ast.rest())) - return _list(_symbol(u"cons"), - quasiquote(a0), - quasiquote(ast.rest())) + return ast def is_macro_call(ast, env): if types._list_Q(ast): @@ -103,6 +108,8 @@ def EVAL(ast, env): env = let_env # Continue loop (TCO) elif u"quote" == a0sym: return ast[1] + elif u"quasiquoteexpand" == a0sym: + return quasiquote(ast[1]) elif u"quasiquote" == a0sym: ast = quasiquote(ast[1]) # Continue loop (TCO) elif u"defmacro!" == a0sym: @@ -152,7 +159,7 @@ def EVAL(ast, env): if isinstance(f, MalFunc): if f.ast: ast = f.ast - env = f.gen_env(el.rest()) # Continue loop (TCO) + env = f.gen_env(el.rest()) # Continue loop (TCO) else: return f.apply(el.rest()) else: diff --git a/impls/rpython/stepA_mal.py b/impls/rpython/stepA_mal.py index dce3b40d..79f26621 100644 --- a/impls/rpython/stepA_mal.py +++ b/impls/rpython/stepA_mal.py @@ -22,27 +22,32 @@ def READ(str): return reader.read_str(str) # eval -def is_pair(x): - return types._sequential_Q(x) and len(x) > 0 +def qq_loop(elt, acc): + if types._list_Q(elt) and len(elt) == 2: + fst = elt[0] + if isinstance(fst, MalSym) and fst.value == u"splice-unquote": + return _list(_symbol(u"concat"), elt[1], acc) + return _list(_symbol(u"cons"), quasiquote(elt), acc) + +def qq_foldr(seq): + acc = _list() + for elt in reversed(seq): + acc = qq_loop (elt, acc) + return acc def quasiquote(ast): - if not is_pair(ast): + if types._list_Q(ast): + if len(ast) == 2: + fst = ast[0] + if isinstance(fst, MalSym) and fst.value == u"unquote": + return ast[1] + return qq_foldr(ast.values) + elif types._vector_Q(ast): + return _list(_symbol(u"vec"), qq_foldr(ast.values)) + elif types._symbol_Q(ast) or types._hash_map_Q(ast): return _list(_symbol(u"quote"), ast) else: - a0 = ast[0] - if isinstance(a0, MalSym): - if a0.value == u'unquote': - return ast[1] - if is_pair(a0) and isinstance(a0[0], MalSym): - a00 = a0[0] - if (isinstance(a00, MalSym) and - a00.value == u'splice-unquote'): - return _list(_symbol(u"concat"), - a0[1], - quasiquote(ast.rest())) - return _list(_symbol(u"cons"), - quasiquote(a0), - quasiquote(ast.rest())) + return ast def is_macro_call(ast, env): if types._list_Q(ast): @@ -112,6 +117,8 @@ def EVAL(ast, env): env = let_env # Continue loop (TCO) elif u"quote" == a0sym: return ast[1] + elif u"quasiquoteexpand" == a0sym: + return quasiquote(ast[1]) elif u"quasiquote" == a0sym: ast = quasiquote(ast[1]) # Continue loop (TCO) elif u"defmacro!" == a0sym: @@ -161,7 +168,7 @@ def EVAL(ast, env): if isinstance(f, MalFunc): if f.ast: ast = f.ast - env = f.gen_env(el.rest()) # Continue loop (TCO) + env = f.gen_env(el.rest()) # Continue loop (TCO) else: return f.apply(el.rest()) else: diff --git a/impls/ruby/core.rb b/impls/ruby/core.rb index 51300c01..4322df01 100644 --- a/impls/ruby/core.rb +++ b/impls/ruby/core.rb @@ -48,6 +48,7 @@ $core_ns = { :vals => lambda {|a| List.new a.values}, :sequential? => lambda {|a| sequential?(a)}, + :vec => lambda {|a| Vector.new a}, :cons => lambda {|a,b| List.new(b.clone.insert(0,a))}, :concat => lambda {|*a| List.new(a && a.reduce(:+) || [])}, :nth => lambda {|a,b| raise "nth: index out of range" if b >= a.size; a[b]}, diff --git a/impls/ruby/step7_quote.rb b/impls/ruby/step7_quote.rb index e099fb28..a5c9d5cc 100644 --- a/impls/ruby/step7_quote.rb +++ b/impls/ruby/step7_quote.rb @@ -11,20 +11,35 @@ def READ(str) end # eval -def pair?(x) - return sequential?(x) && x.size > 0 +def qq_loop(ast) + acc = List.new [] + ast.reverse_each do |elt| + if elt.is_a?(List) && elt.size == 2 && elt[0] == :"splice-unquote" + acc = List.new [:concat, elt[1], acc] + else + acc = List.new [:cons, quasiquote(elt), acc] + end + end + return acc end def quasiquote(ast) - if not pair?(ast) - return List.new [:quote, ast] - elsif ast[0] == :unquote - return ast[1] - elsif pair?(ast[0]) && ast[0][0] == :"splice-unquote" - return List.new [:concat, ast[0][1], quasiquote(ast.drop(1))] + return case ast + when List + if ast.size == 2 && ast[0] == :unquote + ast[1] else - return List.new [:cons, quasiquote(ast[0]), quasiquote(ast.drop(1))] + qq_loop(ast) end + when Vector + List.new [:vec, qq_loop(ast)] + when Hash + List.new [:quote, ast] + when Symbol + List.new [:quote, ast] + else + ast + end end def eval_ast(ast, env) @@ -70,6 +85,8 @@ def EVAL(ast, env) ast = a2 # Continue loop (TCO) when :quote return a1 + when :quasiquoteexpand + return quasiquote(a1); when :quasiquote ast = quasiquote(a1); # Continue loop (TCO) when :do diff --git a/impls/ruby/step8_macros.rb b/impls/ruby/step8_macros.rb index a9cc51dd..8d7b5d02 100644 --- a/impls/ruby/step8_macros.rb +++ b/impls/ruby/step8_macros.rb @@ -11,20 +11,39 @@ def READ(str) end # eval -def pair?(x) - return sequential?(x) && x.size > 0 +def starts_with(ast, sym) + return ast.is_a?(List) && ast.size == 2 && ast[0] == sym +end + +def qq_loop(ast) + acc = List.new [] + ast.reverse_each do |elt| + if starts_with(elt, :"splice-unquote") + acc = List.new [:concat, elt[1], acc] + else + acc = List.new [:cons, quasiquote(elt), acc] + end + end + return acc end def quasiquote(ast) - if not pair?(ast) - return List.new [:quote, ast] - elsif ast[0] == :unquote - return ast[1] - elsif pair?(ast[0]) && ast[0][0] == :"splice-unquote" - return List.new [:concat, ast[0][1], quasiquote(ast.drop(1))] + return case ast + when List + if starts_with(ast, :unquote) + ast[1] else - return List.new [:cons, quasiquote(ast[0]), quasiquote(ast.drop(1))] + qq_loop(ast) end + when Vector + List.new [:vec, qq_loop(ast)] + when Hash + List.new [:quote, ast] + when Symbol + List.new [:quote, ast] + else + ast + end end def macro_call?(ast, env) @@ -91,6 +110,8 @@ def EVAL(ast, env) ast = a2 # Continue loop (TCO) when :quote return a1 + when :quasiquoteexpand + return quasiquote(a1); when :quasiquote ast = quasiquote(a1); # Continue loop (TCO) when :defmacro! diff --git a/impls/ruby/step9_try.rb b/impls/ruby/step9_try.rb index 0c342a09..2bc95c66 100644 --- a/impls/ruby/step9_try.rb +++ b/impls/ruby/step9_try.rb @@ -11,20 +11,39 @@ def READ(str) end # eval -def pair?(x) - return sequential?(x) && x.size > 0 +def starts_with(ast, sym) + return ast.is_a?(List) && ast.size == 2 && ast[0] == sym +end + +def qq_loop(ast) + acc = List.new [] + ast.reverse_each do |elt| + if starts_with(elt, :"splice-unquote") + acc = List.new [:concat, elt[1], acc] + else + acc = List.new [:cons, quasiquote(elt), acc] + end + end + return acc end def quasiquote(ast) - if not pair?(ast) - return List.new [:quote, ast] - elsif ast[0] == :unquote - return ast[1] - elsif pair?(ast[0]) && ast[0][0] == :"splice-unquote" - return List.new [:concat, ast[0][1], quasiquote(ast.drop(1))] + return case ast + when List + if starts_with(ast, :unquote) + ast[1] else - return List.new [:cons, quasiquote(ast[0]), quasiquote(ast.drop(1))] + qq_loop(ast) end + when Vector + List.new [:vec, qq_loop(ast)] + when Hash + List.new [:quote, ast] + when Symbol + List.new [:quote, ast] + else + ast + end end def macro_call?(ast, env) @@ -91,6 +110,8 @@ def EVAL(ast, env) ast = a2 # Continue loop (TCO) when :quote return a1 + when :quasiquoteexpand + return quasiquote(a1); when :quasiquote ast = quasiquote(a1); # Continue loop (TCO) when :defmacro! diff --git a/impls/ruby/stepA_mal.rb b/impls/ruby/stepA_mal.rb index 2f96f373..fb1bb719 100644 --- a/impls/ruby/stepA_mal.rb +++ b/impls/ruby/stepA_mal.rb @@ -11,20 +11,39 @@ def READ(str) end # eval -def pair?(x) - return sequential?(x) && x.size > 0 +def starts_with(ast, sym) + return ast.is_a?(List) && ast.size == 2 && ast[0] == sym +end + +def qq_loop(ast) + acc = List.new [] + ast.reverse_each do |elt| + if starts_with(elt, :"splice-unquote") + acc = List.new [:concat, elt[1], acc] + else + acc = List.new [:cons, quasiquote(elt), acc] + end + end + return acc end def quasiquote(ast) - if not pair?(ast) - return List.new [:quote, ast] - elsif ast[0] == :unquote - return ast[1] - elsif pair?(ast[0]) && ast[0][0] == :"splice-unquote" - return List.new [:concat, ast[0][1], quasiquote(ast.drop(1))] + return case ast + when List + if starts_with(ast, :unquote) + ast[1] else - return List.new [:cons, quasiquote(ast[0]), quasiquote(ast.drop(1))] + qq_loop(ast) end + when Vector + List.new [:vec, qq_loop(ast)] + when Hash + List.new [:quote, ast] + when Symbol + List.new [:quote, ast] + else + ast + end end def macro_call?(ast, env) @@ -91,6 +110,8 @@ def EVAL(ast, env) ast = a2 # Continue loop (TCO) when :quote return a1 + when :quasiquoteexpand + return quasiquote(a1); when :quasiquote ast = quasiquote(a1); # Continue loop (TCO) when :defmacro! diff --git a/impls/rust/core.rs b/impls/rust/core.rs index 6bd0d9c7..58400f7c 100644 --- a/impls/rust/core.rs +++ b/impls/rust/core.rs @@ -143,6 +143,13 @@ fn vals(a: MalArgs) -> MalRet { } } +fn vec(a: MalArgs) -> MalRet { + match a[0] { + List(ref v, _) | Vector(ref v, _) => Ok(vector!(v.to_vec())), + _ => error("non-seq passed to vec"), + } +} + fn cons(a: MalArgs) -> MalRet { match a[1].clone() { List(v, _) | Vector(v, _) => { @@ -321,6 +328,7 @@ pub fn ns() -> Vec<(&'static str, MalVal)> { ("contains?", func(contains_q)), ("keys", func(keys)), ("vals", func(vals)), + ("vec", func(vec)), ("cons", func(cons)), ("concat", func(concat)), ("empty?", func(|a| a[0].empty_q())), diff --git a/impls/rust/step7_quote.rs b/impls/rust/step7_quote.rs index 02042a82..374128a8 100644 --- a/impls/rust/step7_quote.rs +++ b/impls/rust/step7_quote.rs @@ -30,34 +30,40 @@ fn read(str: &str) -> MalRet { } // eval -fn quasiquote(ast: &MalVal) -> MalVal { - match ast { - List(ref v, _) | Vector(ref v, _) if v.len() > 0 => { - let a0 = &v[0]; - match a0 { - Sym(ref s) if s == "unquote" => v[1].clone(), - _ => match a0 { - List(ref v0, _) | Vector(ref v0, _) if v0.len() > 0 => match v0[0] { - Sym(ref s) if s == "splice-unquote" => list![ - Sym("concat".to_string()), - v0[1].clone(), - quasiquote(&list!(v[1..].to_vec())) - ], - _ => list![ - Sym("cons".to_string()), - quasiquote(a0), - quasiquote(&list!(v[1..].to_vec())) - ], - }, - _ => list![ - Sym("cons".to_string()), - quasiquote(a0), - quasiquote(&list!(v[1..].to_vec())) - ], - }, + +fn qq_iter(elts: &MalArgs) -> MalVal { + let mut acc = list![]; + for elt in elts.iter().rev() { + if let List(v, _) = elt { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "splice-unquote" { + acc = list![Sym("concat".to_string()), v[1].clone(), acc]; + continue; + } + } } } - _ => list![Sym("quote".to_string()), ast.clone()], + acc = list![Sym("cons".to_string()), quasiquote(&elt), acc]; + } + return acc; +} + +fn quasiquote(ast: &MalVal) -> MalVal { + match ast { + List(v, _) => { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "unquote" { + return v[1].clone(); + } + } + } + return qq_iter(&v); + }, + Vector(v, _) => return list![Sym("vec".to_string()), qq_iter(&v)], + Hash(_, _) | Sym(_)=> return list![Sym("quote".to_string()), ast.clone()], + _ => ast.clone(), } } @@ -131,6 +137,7 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { continue 'tco; } Sym(ref a0sym) if a0sym == "quote" => Ok(l[1].clone()), + Sym(ref a0sym) if a0sym == "quasiquoteexpand" => Ok(quasiquote(&l[1])), Sym(ref a0sym) if a0sym == "quasiquote" => { ast = quasiquote(&l[1]); continue 'tco; diff --git a/impls/rust/step8_macros.rs b/impls/rust/step8_macros.rs index 3cafd23b..8808f0e1 100644 --- a/impls/rust/step8_macros.rs +++ b/impls/rust/step8_macros.rs @@ -30,34 +30,40 @@ fn read(str: &str) -> MalRet { } // eval -fn quasiquote(ast: &MalVal) -> MalVal { - match ast { - List(ref v, _) | Vector(ref v, _) if v.len() > 0 => { - let a0 = &v[0]; - match a0 { - Sym(ref s) if s == "unquote" => v[1].clone(), - _ => match a0 { - List(ref v0, _) | Vector(ref v0, _) if v0.len() > 0 => match v0[0] { - Sym(ref s) if s == "splice-unquote" => list![ - Sym("concat".to_string()), - v0[1].clone(), - quasiquote(&list!(v[1..].to_vec())) - ], - _ => list![ - Sym("cons".to_string()), - quasiquote(a0), - quasiquote(&list!(v[1..].to_vec())) - ], - }, - _ => list![ - Sym("cons".to_string()), - quasiquote(a0), - quasiquote(&list!(v[1..].to_vec())) - ], - }, + +fn qq_iter(elts: &MalArgs) -> MalVal { + let mut acc = list![]; + for elt in elts.iter().rev() { + if let List(v, _) = elt { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "splice-unquote" { + acc = list![Sym("concat".to_string()), v[1].clone(), acc]; + continue; + } + } } } - _ => list![Sym("quote".to_string()), ast.clone()], + acc = list![Sym("cons".to_string()), quasiquote(&elt), acc]; + } + return acc; +} + +fn quasiquote(ast: &MalVal) -> MalVal { + match ast { + List(v, _) => { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "unquote" { + return v[1].clone(); + } + } + } + return qq_iter(&v); + }, + Vector(v, _) => return list![Sym("vec".to_string()), qq_iter(&v)], + Hash(_, _) | Sym(_)=> return list![Sym("quote".to_string()), ast.clone()], + _ => ast.clone(), } } @@ -173,6 +179,7 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { continue 'tco; } Sym(ref a0sym) if a0sym == "quote" => Ok(l[1].clone()), + Sym(ref a0sym) if a0sym == "quasiquoteexpand" => Ok(quasiquote(&l[1])), Sym(ref a0sym) if a0sym == "quasiquote" => { ast = quasiquote(&l[1]); continue 'tco; diff --git a/impls/rust/step9_try.rs b/impls/rust/step9_try.rs index 5221b2b1..63b90822 100644 --- a/impls/rust/step9_try.rs +++ b/impls/rust/step9_try.rs @@ -31,34 +31,40 @@ fn read(str: &str) -> MalRet { } // eval -fn quasiquote(ast: &MalVal) -> MalVal { - match ast { - List(ref v, _) | Vector(ref v, _) if v.len() > 0 => { - let a0 = &v[0]; - match a0 { - Sym(ref s) if s == "unquote" => v[1].clone(), - _ => match a0 { - List(ref v0, _) | Vector(ref v0, _) if v0.len() > 0 => match v0[0] { - Sym(ref s) if s == "splice-unquote" => list![ - Sym("concat".to_string()), - v0[1].clone(), - quasiquote(&list!(v[1..].to_vec())) - ], - _ => list![ - Sym("cons".to_string()), - quasiquote(a0), - quasiquote(&list!(v[1..].to_vec())) - ], - }, - _ => list![ - Sym("cons".to_string()), - quasiquote(a0), - quasiquote(&list!(v[1..].to_vec())) - ], - }, + +fn qq_iter(elts: &MalArgs) -> MalVal { + let mut acc = list![]; + for elt in elts.iter().rev() { + if let List(v, _) = elt { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "splice-unquote" { + acc = list![Sym("concat".to_string()), v[1].clone(), acc]; + continue; + } + } } } - _ => list![Sym("quote".to_string()), ast.clone()], + acc = list![Sym("cons".to_string()), quasiquote(&elt), acc]; + } + return acc; +} + +fn quasiquote(ast: &MalVal) -> MalVal { + match ast { + List(v, _) => { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "unquote" { + return v[1].clone(); + } + } + } + return qq_iter(&v); + }, + Vector(v, _) => return list![Sym("vec".to_string()), qq_iter(&v)], + Hash(_, _) | Sym(_)=> return list![Sym("quote".to_string()), ast.clone()], + _ => ast.clone(), } } @@ -174,6 +180,7 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { continue 'tco; } Sym(ref a0sym) if a0sym == "quote" => Ok(l[1].clone()), + Sym(ref a0sym) if a0sym == "quasiquoteexpand" => Ok(quasiquote(&l[1])), Sym(ref a0sym) if a0sym == "quasiquote" => { ast = quasiquote(&l[1]); continue 'tco; diff --git a/impls/rust/stepA_mal.rs b/impls/rust/stepA_mal.rs index 8b388a71..6b86d6b5 100644 --- a/impls/rust/stepA_mal.rs +++ b/impls/rust/stepA_mal.rs @@ -33,34 +33,40 @@ fn read(str: &str) -> MalRet { } // eval -fn quasiquote(ast: &MalVal) -> MalVal { - match ast { - List(ref v, _) | Vector(ref v, _) if v.len() > 0 => { - let a0 = &v[0]; - match a0 { - Sym(ref s) if s == "unquote" => v[1].clone(), - _ => match a0 { - List(ref v0, _) | Vector(ref v0, _) if v0.len() > 0 => match v0[0] { - Sym(ref s) if s == "splice-unquote" => list![ - Sym("concat".to_string()), - v0[1].clone(), - quasiquote(&list!(v[1..].to_vec())) - ], - _ => list![ - Sym("cons".to_string()), - quasiquote(a0), - quasiquote(&list!(v[1..].to_vec())) - ], - }, - _ => list![ - Sym("cons".to_string()), - quasiquote(a0), - quasiquote(&list!(v[1..].to_vec())) - ], - }, + +fn qq_iter(elts: &MalArgs) -> MalVal { + let mut acc = list![]; + for elt in elts.iter().rev() { + if let List(v, _) = elt { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "splice-unquote" { + acc = list![Sym("concat".to_string()), v[1].clone(), acc]; + continue; + } + } } } - _ => list![Sym("quote".to_string()), ast.clone()], + acc = list![Sym("cons".to_string()), quasiquote(&elt), acc]; + } + return acc; +} + +fn quasiquote(ast: &MalVal) -> MalVal { + match ast { + List(v, _) => { + if v.len() == 2 { + if let Sym(ref s) = v[0] { + if s == "unquote" { + return v[1].clone(); + } + } + } + return qq_iter(&v); + }, + Vector(v, _) => return list![Sym("vec".to_string()), qq_iter(&v)], + Hash(_, _) | Sym(_)=> return list![Sym("quote".to_string()), ast.clone()], + _ => ast.clone(), } } @@ -176,6 +182,7 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { continue 'tco; } Sym(ref a0sym) if a0sym == "quote" => Ok(l[1].clone()), + Sym(ref a0sym) if a0sym == "quasiquoteexpand" => Ok(quasiquote(&l[1])), Sym(ref a0sym) if a0sym == "quasiquote" => { ast = quasiquote(&l[1]); continue 'tco; diff --git a/impls/scala/core.scala b/impls/scala/core.scala index c56851be..95136313 100644 --- a/impls/scala/core.scala +++ b/impls/scala/core.scala @@ -294,6 +294,7 @@ object core { "sequential?" -> ((a: List[Any]) => types._sequential_Q(a(0))), "cons" -> ((a: List[Any]) => a(0) +: a(1).asInstanceOf[MalList]), "concat" -> concat _, + "vec" -> ((a: List[Any]) => _vector(a(0).asInstanceOf[MalList].value:_*)), "nth" -> nth _, "first" -> first _, "rest" -> rest _, diff --git a/impls/scala/step7_quote.scala b/impls/scala/step7_quote.scala index 81e6625d..4afd5f59 100644 --- a/impls/scala/step7_quote.scala +++ b/impls/scala/step7_quote.scala @@ -9,30 +9,40 @@ object step7_quote { } // eval - def is_pair(x: Any): Boolean = { - types._sequential_Q(x) && x.asInstanceOf[MalList].value.length > 0 + def quasiquote_loop(elts: List[Any]): MalList = { + var acc = _list() + for (elt <- elts.reverse) { + if (types._list_Q(elt)) { + elt.asInstanceOf[MalList].value match { + case Symbol("splice-unquote") :: x :: Nil => { + acc = _list(Symbol("concat"), x, acc) + } + case _ => { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + } else { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + return acc } def quasiquote(ast: Any): Any = { - if (!is_pair(ast)) { - return _list(Symbol("quote"), ast) - } else { - val a0 = ast.asInstanceOf[MalList](0) - if (types._symbol_Q(a0) && - a0.asInstanceOf[Symbol].name == "unquote") { - return ast.asInstanceOf[MalList](1) - } else if (is_pair(a0)) { - val a00 = a0.asInstanceOf[MalList](0) - if (types._symbol_Q(a00) && - a00.asInstanceOf[Symbol].name == "splice-unquote") { - return _list(Symbol("concat"), - a0.asInstanceOf[MalList](1), - quasiquote(ast.asInstanceOf[MalList].drop(1))) + ast match { + // Test vectors before they match MalList. + case v: MalVector => { + _list(Symbol("vec"), quasiquote_loop(v.value)) + } + case l: MalList => { + l.value match { + case Symbol("unquote") :: x :: Nil => x + case _ => quasiquote_loop(l.value) } } - return _list(Symbol("cons"), - quasiquote(a0), - quasiquote(ast.asInstanceOf[MalList].drop(1))) + case _ : Symbol => _list(Symbol("quote"), ast) + case _ : MalHashMap => _list(Symbol("quote"), ast) + case _ => ast } } @@ -75,6 +85,9 @@ object step7_quote { case Symbol("quote") :: a1 :: Nil => { return a1 } + case Symbol("quasiquoteexpand") :: a1 :: Nil => { + return quasiquote(a1) + } case Symbol("quasiquote") :: a1 :: Nil => { ast = quasiquote(a1) // continue loop (TCO) } diff --git a/impls/scala/step8_macros.scala b/impls/scala/step8_macros.scala index aebecf46..614aeb05 100644 --- a/impls/scala/step8_macros.scala +++ b/impls/scala/step8_macros.scala @@ -9,30 +9,40 @@ object step8_macros { } // eval - def is_pair(x: Any): Boolean = { - types._sequential_Q(x) && x.asInstanceOf[MalList].value.length > 0 + def quasiquote_loop(elts: List[Any]): MalList = { + var acc = _list() + for (elt <- elts.reverse) { + if (types._list_Q(elt)) { + elt.asInstanceOf[MalList].value match { + case Symbol("splice-unquote") :: x :: Nil => { + acc = _list(Symbol("concat"), x, acc) + } + case _ => { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + } else { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + return acc } def quasiquote(ast: Any): Any = { - if (!is_pair(ast)) { - return _list(Symbol("quote"), ast) - } else { - val a0 = ast.asInstanceOf[MalList](0) - if (types._symbol_Q(a0) && - a0.asInstanceOf[Symbol].name == "unquote") { - return ast.asInstanceOf[MalList](1) - } else if (is_pair(a0)) { - val a00 = a0.asInstanceOf[MalList](0) - if (types._symbol_Q(a00) && - a00.asInstanceOf[Symbol].name == "splice-unquote") { - return _list(Symbol("concat"), - a0.asInstanceOf[MalList](1), - quasiquote(ast.asInstanceOf[MalList].drop(1))) + ast match { + // Test vectors before they match MalList. + case v: MalVector => { + _list(Symbol("vec"), quasiquote_loop(v.value)) + } + case l: MalList => { + l.value match { + case Symbol("unquote") :: x :: Nil => x + case _ => quasiquote_loop(l.value) } } - return _list(Symbol("cons"), - quasiquote(a0), - quasiquote(ast.asInstanceOf[MalList].drop(1))) + case _ : Symbol => _list(Symbol("quote"), ast) + case _ : MalHashMap => _list(Symbol("quote"), ast) + case _ => ast } } @@ -110,6 +120,9 @@ object step8_macros { case Symbol("quote") :: a1 :: Nil => { return a1 } + case Symbol("quasiquoteexpand") :: a1 :: Nil => { + return quasiquote(a1) + } case Symbol("quasiquote") :: a1 :: Nil => { ast = quasiquote(a1) // continue loop (TCO) } diff --git a/impls/scala/step9_try.scala b/impls/scala/step9_try.scala index 70227ada..153839f0 100644 --- a/impls/scala/step9_try.scala +++ b/impls/scala/step9_try.scala @@ -9,30 +9,40 @@ object step9_try { } // eval - def is_pair(x: Any): Boolean = { - types._sequential_Q(x) && x.asInstanceOf[MalList].value.length > 0 + def quasiquote_loop(elts: List[Any]): MalList = { + var acc = _list() + for (elt <- elts.reverse) { + if (types._list_Q(elt)) { + elt.asInstanceOf[MalList].value match { + case Symbol("splice-unquote") :: x :: Nil => { + acc = _list(Symbol("concat"), x, acc) + } + case _ => { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + } else { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + return acc } def quasiquote(ast: Any): Any = { - if (!is_pair(ast)) { - return _list(Symbol("quote"), ast) - } else { - val a0 = ast.asInstanceOf[MalList](0) - if (types._symbol_Q(a0) && - a0.asInstanceOf[Symbol].name == "unquote") { - return ast.asInstanceOf[MalList](1) - } else if (is_pair(a0)) { - val a00 = a0.asInstanceOf[MalList](0) - if (types._symbol_Q(a00) && - a00.asInstanceOf[Symbol].name == "splice-unquote") { - return _list(Symbol("concat"), - a0.asInstanceOf[MalList](1), - quasiquote(ast.asInstanceOf[MalList].drop(1))) + ast match { + // Test vectors before they match MalList. + case v: MalVector => { + _list(Symbol("vec"), quasiquote_loop(v.value)) + } + case l: MalList => { + l.value match { + case Symbol("unquote") :: x :: Nil => x + case _ => quasiquote_loop(l.value) } } - return _list(Symbol("cons"), - quasiquote(a0), - quasiquote(ast.asInstanceOf[MalList].drop(1))) + case _ : Symbol => _list(Symbol("quote"), ast) + case _ : MalHashMap => _list(Symbol("quote"), ast) + case _ => ast } } @@ -110,6 +120,9 @@ object step9_try { case Symbol("quote") :: a1 :: Nil => { return a1 } + case Symbol("quasiquoteexpand") :: a1 :: Nil => { + return quasiquote(a1) + } case Symbol("quasiquote") :: a1 :: Nil => { ast = quasiquote(a1) // continue loop (TCO) } diff --git a/impls/scala/stepA_mal.scala b/impls/scala/stepA_mal.scala index 77ced958..f5781cec 100644 --- a/impls/scala/stepA_mal.scala +++ b/impls/scala/stepA_mal.scala @@ -9,30 +9,40 @@ object stepA_mal { } // eval - def is_pair(x: Any): Boolean = { - types._sequential_Q(x) && x.asInstanceOf[MalList].value.length > 0 + def quasiquote_loop(elts: List[Any]): MalList = { + var acc = _list() + for (elt <- elts.reverse) { + if (types._list_Q(elt)) { + elt.asInstanceOf[MalList].value match { + case Symbol("splice-unquote") :: x :: Nil => { + acc = _list(Symbol("concat"), x, acc) + } + case _ => { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + } else { + acc = _list(Symbol("cons"), quasiquote(elt), acc) + } + } + return acc } def quasiquote(ast: Any): Any = { - if (!is_pair(ast)) { - return _list(Symbol("quote"), ast) - } else { - val a0 = ast.asInstanceOf[MalList](0) - if (types._symbol_Q(a0) && - a0.asInstanceOf[Symbol].name == "unquote") { - return ast.asInstanceOf[MalList](1) - } else if (is_pair(a0)) { - val a00 = a0.asInstanceOf[MalList](0) - if (types._symbol_Q(a00) && - a00.asInstanceOf[Symbol].name == "splice-unquote") { - return _list(Symbol("concat"), - a0.asInstanceOf[MalList](1), - quasiquote(ast.asInstanceOf[MalList].drop(1))) + ast match { + // Test vectors before they match MalList. + case v: MalVector => { + _list(Symbol("vec"), quasiquote_loop(v.value)) + } + case l: MalList => { + l.value match { + case Symbol("unquote") :: x :: Nil => x + case _ => quasiquote_loop(l.value) } } - return _list(Symbol("cons"), - quasiquote(a0), - quasiquote(ast.asInstanceOf[MalList].drop(1))) + case _ : Symbol => _list(Symbol("quote"), ast) + case _ : MalHashMap => _list(Symbol("quote"), ast) + case _ => ast } } @@ -110,6 +120,9 @@ object stepA_mal { case Symbol("quote") :: a1 :: Nil => { return a1 } + case Symbol("quasiquoteexpand") :: a1 :: Nil => { + return quasiquote(a1) + } case Symbol("quasiquote") :: a1 :: Nil => { ast = quasiquote(a1) // continue loop (TCO) } diff --git a/impls/scheme/lib/core.sld b/impls/scheme/lib/core.sld index 54703824..dcb8267f 100644 --- a/impls/scheme/lib/core.sld +++ b/impls/scheme/lib/core.sld @@ -187,6 +187,11 @@ (cons . ,(lambda (x xs) (mal-list (cons x (->list (mal-value xs)))))) (concat . ,(lambda args (mal-list (apply append (map (lambda (arg) (->list (mal-value arg))) args))))) + (vec . ,(lambda (x) + (case (mal-type x) + ((vector) x) + ((list) (mal-vector (list->vector (mal-value x)))) + (else (error "seq expects a sequence"))))) (nth . ,(lambda (x n) (let ((items (->list (mal-value x))) (index (mal-value n))) (if (< index (length items)) diff --git a/impls/scheme/step7_quote.scm b/impls/scheme/step7_quote.scm index c02b0c59..b5527b8a 100644 --- a/impls/scheme/step7_quote.scm +++ b/impls/scheme/step7_quote.scm @@ -22,31 +22,30 @@ ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value))) (else ast)))) -(define (is-pair? ast) - (let ((type (and (mal-object? ast) (mal-type ast)))) - (if (memq type '(list vector)) - (pair? (->list (mal-value ast))) - #f))) +(define (starts-with? ast sym) + (let ((items (mal-value ast))) + (and (not (null? items)) + (let ((a0 (car items))) + (and (mal-instance-of? a0 'symbol) + (eq? (mal-value a0) sym)))))) + +(define (qq-lst xs) + (if (null? xs) + (mal-list '()) + (let ((elt (car xs)) + (acc (qq-lst (cdr xs)))) + (if (and (mal-instance-of? elt 'list) (starts-with? elt 'splice-unquote)) + (mal-list (list (mal-symbol 'concat) (cadr (mal-value elt)) acc)) + (mal-list (list (mal-symbol 'cons) (QUASIQUOTE elt) acc)))))) (define (QUASIQUOTE ast) - (if (not (is-pair? ast)) - (mal-list (list (mal-symbol 'quote) ast)) - (let* ((items (->list (mal-value ast))) - (a0 (car items))) - (if (and (mal-object? a0) - (eq? (mal-type a0) 'symbol) - (eq? (mal-value a0) 'unquote)) - (cadr items) - (if (and (is-pair? a0) - (mal-object? (car (mal-value a0))) - (eq? (mal-type (car (mal-value a0))) 'symbol) - (eq? (mal-value (car (mal-value a0))) 'splice-unquote)) - (mal-list (list (mal-symbol 'concat) - (cadr (mal-value a0)) - (QUASIQUOTE (mal-list (cdr items))))) - (mal-list (list (mal-symbol 'cons) - (QUASIQUOTE a0) - (QUASIQUOTE (mal-list (cdr items)))))))))) + (case (and (mal-object? ast) (mal-type ast)) + ((list) (if (starts-with? ast 'unquote) + (cadr (mal-value ast)) + (qq-lst (->list (mal-value ast))))) + ((vector) (mal-list (list (mal-symbol 'vec) (qq-lst (->list (mal-value ast)))))) + ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) + (else ast))) (define (EVAL ast env) (let ((type (and (mal-object? ast) (mal-type ast)))) @@ -98,6 +97,7 @@ (EVAL (list-ref items 3) env)) ; TCO (EVAL (list-ref items 2) env)))) ; TCO ((quote) (cadr items)) + ((quasiquoteexpand) (QUASIQUOTE (cadr items))) ((quasiquote) (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO ((fn*) (let* ((binds (->list (mal-value (cadr items)))) diff --git a/impls/scheme/step8_macros.scm b/impls/scheme/step8_macros.scm index eddf06f7..bd978b2b 100644 --- a/impls/scheme/step8_macros.scm +++ b/impls/scheme/step8_macros.scm @@ -22,31 +22,30 @@ ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value))) (else ast)))) -(define (is-pair? ast) - (let ((type (and (mal-object? ast) (mal-type ast)))) - (if (memq type '(list vector)) - (pair? (->list (mal-value ast))) - #f))) +(define (starts-with? ast sym) + (let ((items (mal-value ast))) + (and (not (null? items)) + (let ((a0 (car items))) + (and (mal-instance-of? a0 'symbol) + (eq? (mal-value a0) sym)))))) + +(define (qq-lst xs) + (if (null? xs) + (mal-list '()) + (let ((elt (car xs)) + (acc (qq-lst (cdr xs)))) + (if (and (mal-instance-of? elt 'list) (starts-with? elt 'splice-unquote)) + (mal-list (list (mal-symbol 'concat) (cadr (mal-value elt)) acc)) + (mal-list (list (mal-symbol 'cons) (QUASIQUOTE elt) acc)))))) (define (QUASIQUOTE ast) - (if (not (is-pair? ast)) - (mal-list (list (mal-symbol 'quote) ast)) - (let* ((items (->list (mal-value ast))) - (a0 (car items))) - (if (and (mal-object? a0) - (eq? (mal-type a0) 'symbol) - (eq? (mal-value a0) 'unquote)) - (cadr items) - (if (and (is-pair? a0) - (mal-object? (car (mal-value a0))) - (eq? (mal-type (car (mal-value a0))) 'symbol) - (eq? (mal-value (car (mal-value a0))) 'splice-unquote)) - (mal-list (list (mal-symbol 'concat) - (cadr (mal-value a0)) - (QUASIQUOTE (mal-list (cdr items))))) - (mal-list (list (mal-symbol 'cons) - (QUASIQUOTE a0) - (QUASIQUOTE (mal-list (cdr items)))))))))) + (case (and (mal-object? ast) (mal-type ast)) + ((list) (if (starts-with? ast 'unquote) + (cadr (mal-value ast)) + (qq-lst (->list (mal-value ast))))) + ((vector) (mal-list (list (mal-symbol 'vec) (qq-lst (->list (mal-value ast)))))) + ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) + (else ast))) (define (is-macro-call? ast env) (if (mal-instance-of? ast 'list) @@ -134,6 +133,8 @@ (EVAL (list-ref items 2) env)))) ; TCO ((quote) (cadr items)) + ((quasiquoteexpand) + (QUASIQUOTE (cadr items))) ((quasiquote) (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO ((fn*) @@ -173,7 +174,6 @@ (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)))))))") - (define (main) (let loop () (let ((input (readline "user> "))) diff --git a/impls/scheme/step9_try.scm b/impls/scheme/step9_try.scm index 85198054..a670289e 100644 --- a/impls/scheme/step9_try.scm +++ b/impls/scheme/step9_try.scm @@ -22,31 +22,30 @@ ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value))) (else ast)))) -(define (is-pair? ast) - (let ((type (and (mal-object? ast) (mal-type ast)))) - (if (memq type '(list vector)) - (pair? (->list (mal-value ast))) - #f))) +(define (starts-with? ast sym) + (let ((items (mal-value ast))) + (and (not (null? items)) + (let ((a0 (car items))) + (and (mal-instance-of? a0 'symbol) + (eq? (mal-value a0) sym)))))) + +(define (qq-lst xs) + (if (null? xs) + (mal-list '()) + (let ((elt (car xs)) + (acc (qq-lst (cdr xs)))) + (if (and (mal-instance-of? elt 'list) (starts-with? elt 'splice-unquote)) + (mal-list (list (mal-symbol 'concat) (cadr (mal-value elt)) acc)) + (mal-list (list (mal-symbol 'cons) (QUASIQUOTE elt) acc)))))) (define (QUASIQUOTE ast) - (if (not (is-pair? ast)) - (mal-list (list (mal-symbol 'quote) ast)) - (let* ((items (->list (mal-value ast))) - (a0 (car items))) - (if (and (mal-object? a0) - (eq? (mal-type a0) 'symbol) - (eq? (mal-value a0) 'unquote)) - (cadr items) - (if (and (is-pair? a0) - (mal-object? (car (mal-value a0))) - (eq? (mal-type (car (mal-value a0))) 'symbol) - (eq? (mal-value (car (mal-value a0))) 'splice-unquote)) - (mal-list (list (mal-symbol 'concat) - (cadr (mal-value a0)) - (QUASIQUOTE (mal-list (cdr items))))) - (mal-list (list (mal-symbol 'cons) - (QUASIQUOTE a0) - (QUASIQUOTE (mal-list (cdr items)))))))))) + (case (and (mal-object? ast) (mal-type ast)) + ((list) (if (starts-with? ast 'unquote) + (cadr (mal-value ast)) + (qq-lst (->list (mal-value ast))))) + ((vector) (mal-list (list (mal-symbol 'vec) (qq-lst (->list (mal-value ast)))))) + ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) + (else ast))) (define (is-macro-call? ast env) (if (mal-instance-of? ast 'list) @@ -152,6 +151,8 @@ (EVAL (list-ref items 2) env)))) ; TCO ((quote) (cadr items)) + ((quasiquoteexpand) + (QUASIQUOTE (cadr items))) ((quasiquote) (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO ((fn*) @@ -191,7 +192,6 @@ (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)))))))") - (define (main) (let loop () (let ((input (readline "user> "))) diff --git a/impls/scheme/stepA_mal.scm b/impls/scheme/stepA_mal.scm index 26bb4805..f054354b 100644 --- a/impls/scheme/stepA_mal.scm +++ b/impls/scheme/stepA_mal.scm @@ -22,31 +22,30 @@ ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value))) (else ast)))) -(define (is-pair? ast) - (let ((type (and (mal-object? ast) (mal-type ast)))) - (if (memq type '(list vector)) - (pair? (->list (mal-value ast))) - #f))) +(define (starts-with? ast sym) + (let ((items (mal-value ast))) + (and (not (null? items)) + (let ((a0 (car items))) + (and (mal-instance-of? a0 'symbol) + (eq? (mal-value a0) sym)))))) + +(define (qq-lst xs) + (if (null? xs) + (mal-list '()) + (let ((elt (car xs)) + (acc (qq-lst (cdr xs)))) + (if (and (mal-instance-of? elt 'list) (starts-with? elt 'splice-unquote)) + (mal-list (list (mal-symbol 'concat) (cadr (mal-value elt)) acc)) + (mal-list (list (mal-symbol 'cons) (QUASIQUOTE elt) acc)))))) (define (QUASIQUOTE ast) - (if (not (is-pair? ast)) - (mal-list (list (mal-symbol 'quote) ast)) - (let* ((items (->list (mal-value ast))) - (a0 (car items))) - (if (and (mal-object? a0) - (eq? (mal-type a0) 'symbol) - (eq? (mal-value a0) 'unquote)) - (cadr items) - (if (and (is-pair? a0) - (mal-object? (car (mal-value a0))) - (eq? (mal-type (car (mal-value a0))) 'symbol) - (eq? (mal-value (car (mal-value a0))) 'splice-unquote)) - (mal-list (list (mal-symbol 'concat) - (cadr (mal-value a0)) - (QUASIQUOTE (mal-list (cdr items))))) - (mal-list (list (mal-symbol 'cons) - (QUASIQUOTE a0) - (QUASIQUOTE (mal-list (cdr items)))))))))) + (case (and (mal-object? ast) (mal-type ast)) + ((list) (if (starts-with? ast 'unquote) + (cadr (mal-value ast)) + (qq-lst (->list (mal-value ast))))) + ((vector) (mal-list (list (mal-symbol 'vec) (qq-lst (->list (mal-value ast)))))) + ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) + (else ast))) (define (is-macro-call? ast env) (if (mal-instance-of? ast 'list) @@ -152,6 +151,8 @@ (EVAL (list-ref items 2) env)))) ; TCO ((quote) (cadr items)) + ((quasiquoteexpand) + (QUASIQUOTE (cadr items))) ((quasiquote) (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO ((fn*) diff --git a/impls/skew/core.sk b/impls/skew/core.sk index bd470a1e..a337ab72 100644 --- a/impls/skew/core.sk +++ b/impls/skew/core.sk @@ -66,6 +66,7 @@ const ns StringMap) MalVal> = { a.each(e => list.append((e as MalSequential).val)) return MalList.new(list) }, + "vec": (a List) => a[0] is MalVector ? a[0] : MalVector.new((a[0] as MalSequential).val), "nth": (a List) => (a[0] as MalSequential).nth((a[1] as MalNumber).val), "first": (a List) => a[0] is MalNil ? gNil : (a[0] as MalSequential).first, "rest": (a List) => a[0] is MalNil ? MalList.new([]) : (a[0] as MalSequential).rest, diff --git a/impls/skew/step7_quote.sk b/impls/skew/step7_quote.sk index ed2f3476..e7526ffb 100644 --- a/impls/skew/step7_quote.sk +++ b/impls/skew/step7_quote.sk @@ -2,26 +2,35 @@ def READ(str string) MalVal { return read_str(str) } -def isPair(a MalVal) bool { - return a is MalSequential && !(a as MalSequential).isEmpty +def starts_with(lst MalList, sym string) bool { + return lst.count == 2 && lst[0].isSymbol(sym) +} +def qq_loop(elt MalVal, acc MalList) MalList { + if elt is MalList && starts_with(elt as MalList, "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), (elt as MalList)[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } +} +def qq_foldr(xs List) MalList { + var acc = MalList.new([]) + for i = xs.count-1; 0 <= i; i -= 1 { + acc = qq_loop(xs[i], acc) + } + return acc } - def quasiquote(ast MalVal) MalVal { - if !isPair(ast) { + if ast is MalVector { + return MalList.new([MalSymbol.new("vec"), qq_foldr((ast as MalVector).val)]) + } else if ast is MalSymbol || ast is MalHashMap { return MalList.new([MalSymbol.new("quote"), ast]) + } else if !(ast is MalList) { + return ast + } else if starts_with(ast as MalList, "unquote") { + return (ast as MalList)[1] + } else { + return qq_foldr((ast as MalList).val) } - const astSeq = ast as MalSequential - const a0 = astSeq[0] - if a0.isSymbol("unquote") { - return astSeq[1] - } - if isPair(a0) { - const a0Seq = a0 as MalSequential - if a0Seq[0].isSymbol("splice-unquote") { - return MalList.new([MalSymbol.new("concat"), a0Seq[1], quasiquote(astSeq.rest)]) - } - } - return MalList.new([MalSymbol.new("cons"), quasiquote(a0), quasiquote(astSeq.rest)]) } def eval_ast(ast MalVal, env Env) MalVal { @@ -62,6 +71,8 @@ def EVAL(ast MalVal, env Env) MalVal { continue # TCO } else if a0sym.val == "quote" { return astList[1] + } else if a0sym.val == "quasiquoteexpand" { + return quasiquote(astList[1]) } else if a0sym.val == "quasiquote" { ast = quasiquote(astList[1]) continue # TCO diff --git a/impls/skew/step8_macros.sk b/impls/skew/step8_macros.sk index ed76ff27..54e0358a 100644 --- a/impls/skew/step8_macros.sk +++ b/impls/skew/step8_macros.sk @@ -2,26 +2,35 @@ def READ(str string) MalVal { return read_str(str) } -def isPair(a MalVal) bool { - return a is MalSequential && !(a as MalSequential).isEmpty +def starts_with(lst MalList, sym string) bool { + return lst.count == 2 && lst[0].isSymbol(sym) +} +def qq_loop(elt MalVal, acc MalList) MalList { + if elt is MalList && starts_with(elt as MalList, "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), (elt as MalList)[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } +} +def qq_foldr(xs List) MalList { + var acc = MalList.new([]) + for i = xs.count-1; 0 <= i; i -= 1 { + acc = qq_loop(xs[i], acc) + } + return acc } - def quasiquote(ast MalVal) MalVal { - if !isPair(ast) { + if ast is MalVector { + return MalList.new([MalSymbol.new("vec"), qq_foldr((ast as MalVector).val)]) + } else if ast is MalSymbol || ast is MalHashMap { return MalList.new([MalSymbol.new("quote"), ast]) + } else if !(ast is MalList) { + return ast + } else if starts_with(ast as MalList, "unquote") { + return (ast as MalList)[1] + } else { + return qq_foldr((ast as MalList).val) } - const astSeq = ast as MalSequential - const a0 = astSeq[0] - if a0.isSymbol("unquote") { - return astSeq[1] - } - if isPair(a0) { - const a0Seq = a0 as MalSequential - if a0Seq[0].isSymbol("splice-unquote") { - return MalList.new([MalSymbol.new("concat"), a0Seq[1], quasiquote(astSeq.rest)]) - } - } - return MalList.new([MalSymbol.new("cons"), quasiquote(a0), quasiquote(astSeq.rest)]) } def isMacro(ast MalVal, env Env) bool { @@ -86,6 +95,8 @@ def EVAL(ast MalVal, env Env) MalVal { continue # TCO } else if a0sym.val == "quote" { return astList[1] + } else if a0sym.val == "quasiquoteexpand" { + return quasiquote(astList[1]) } else if a0sym.val == "quasiquote" { ast = quasiquote(astList[1]) continue # TCO diff --git a/impls/skew/step9_try.sk b/impls/skew/step9_try.sk index fb697993..74716bfa 100644 --- a/impls/skew/step9_try.sk +++ b/impls/skew/step9_try.sk @@ -2,26 +2,35 @@ def READ(str string) MalVal { return read_str(str) } -def isPair(a MalVal) bool { - return a is MalSequential && !(a as MalSequential).isEmpty +def starts_with(lst MalList, sym string) bool { + return lst.count == 2 && lst[0].isSymbol(sym) +} +def qq_loop(elt MalVal, acc MalList) MalList { + if elt is MalList && starts_with(elt as MalList, "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), (elt as MalList)[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } +} +def qq_foldr(xs List) MalList { + var acc = MalList.new([]) + for i = xs.count-1; 0 <= i; i -= 1 { + acc = qq_loop(xs[i], acc) + } + return acc } - def quasiquote(ast MalVal) MalVal { - if !isPair(ast) { + if ast is MalVector { + return MalList.new([MalSymbol.new("vec"), qq_foldr((ast as MalVector).val)]) + } else if ast is MalSymbol || ast is MalHashMap { return MalList.new([MalSymbol.new("quote"), ast]) + } else if !(ast is MalList) { + return ast + } else if starts_with(ast as MalList, "unquote") { + return (ast as MalList)[1] + } else { + return qq_foldr((ast as MalList).val) } - const astSeq = ast as MalSequential - const a0 = astSeq[0] - if a0.isSymbol("unquote") { - return astSeq[1] - } - if isPair(a0) { - const a0Seq = a0 as MalSequential - if a0Seq[0].isSymbol("splice-unquote") { - return MalList.new([MalSymbol.new("concat"), a0Seq[1], quasiquote(astSeq.rest)]) - } - } - return MalList.new([MalSymbol.new("cons"), quasiquote(a0), quasiquote(astSeq.rest)]) } def isMacro(ast MalVal, env Env) bool { @@ -86,6 +95,8 @@ def EVAL(ast MalVal, env Env) MalVal { continue # TCO } else if a0sym.val == "quote" { return astList[1] + } else if a0sym.val == "quasiquoteexpand" { + return quasiquote(astList[1]) } else if a0sym.val == "quasiquote" { ast = quasiquote(astList[1]) continue # TCO diff --git a/impls/skew/stepA_mal.sk b/impls/skew/stepA_mal.sk index 09ee5094..891f10d7 100644 --- a/impls/skew/stepA_mal.sk +++ b/impls/skew/stepA_mal.sk @@ -2,26 +2,35 @@ def READ(str string) MalVal { return read_str(str) } -def isPair(a MalVal) bool { - return a is MalSequential && !(a as MalSequential).isEmpty +def starts_with(lst MalList, sym string) bool { + return lst.count == 2 && lst[0].isSymbol(sym) +} +def qq_loop(elt MalVal, acc MalList) MalList { + if elt is MalList && starts_with(elt as MalList, "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), (elt as MalList)[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } +} +def qq_foldr(xs List) MalList { + var acc = MalList.new([]) + for i = xs.count-1; 0 <= i; i -= 1 { + acc = qq_loop(xs[i], acc) + } + return acc } - def quasiquote(ast MalVal) MalVal { - if !isPair(ast) { + if ast is MalVector { + return MalList.new([MalSymbol.new("vec"), qq_foldr((ast as MalVector).val)]) + } else if ast is MalSymbol || ast is MalHashMap { return MalList.new([MalSymbol.new("quote"), ast]) + } else if !(ast is MalList) { + return ast + } else if starts_with(ast as MalList, "unquote") { + return (ast as MalList)[1] + } else { + return qq_foldr((ast as MalList).val) } - const astSeq = ast as MalSequential - const a0 = astSeq[0] - if a0.isSymbol("unquote") { - return astSeq[1] - } - if isPair(a0) { - const a0Seq = a0 as MalSequential - if a0Seq[0].isSymbol("splice-unquote") { - return MalList.new([MalSymbol.new("concat"), a0Seq[1], quasiquote(astSeq.rest)]) - } - } - return MalList.new([MalSymbol.new("cons"), quasiquote(a0), quasiquote(astSeq.rest)]) } def isMacro(ast MalVal, env Env) bool { @@ -86,6 +95,8 @@ def EVAL(ast MalVal, env Env) MalVal { continue # TCO } else if a0sym.val == "quote" { return astList[1] + } else if a0sym.val == "quasiquoteexpand" { + return quasiquote(astList[1]) } else if a0sym.val == "quasiquote" { ast = quasiquote(astList[1]) continue # TCO diff --git a/impls/swift/core.swift b/impls/swift/core.swift index 52d662b3..8b600b37 100644 --- a/impls/swift/core.swift +++ b/impls/swift/core.swift @@ -256,6 +256,10 @@ private func fn_concat(args: MalVarArgs) throws -> MalVal { return result } +private func fn_vec(seq: MalSequence) throws -> MalVal { + return make_vector(seq) +} + private func fn_nth(list: MalSequence, index: MalIntType) throws -> MalVal { return try list.nth(index) } @@ -738,6 +742,7 @@ let ns: [String: MalBuiltin.Signature] = [ "sequential?": { try unwrap_args($0, forFunction: fn_sequentialQ) }, "cons": { try unwrap_args($0, forFunction: fn_cons) }, "concat": { try unwrap_args($0, forFunction: fn_concat) }, + "vec": { try unwrap_args($0, forFunction: fn_vec) }, "nth": { try unwrap_args($0, forFunction: fn_nth) }, "first": { try unwrap_args($0, forFunction: fn_first) }, "rest": { try unwrap_args($0, forFunction: fn_rest) }, diff --git a/impls/swift/step7_quote.swift b/impls/swift/step7_quote.swift index 89a84d2a..f9397a76 100644 --- a/impls/swift/step7_quote.swift +++ b/impls/swift/step7_quote.swift @@ -61,10 +61,12 @@ private let kValFn = make_symbol("fn*") private let kValIf = make_symbol("if") private let kValLet = make_symbol("let*") private let kValQuasiQuote = make_symbol("quasiquote") +private let kValQuasiQuoteExp = make_symbol("quasiquoteexpand") private let kValQuote = make_symbol("quote") private let kValSpliceUnquote = make_symbol("splice-unquote") private let kValUnquote = make_symbol("unquote") private let kValTry = make_symbol("try*") +private let kValVec = make_symbol("vec") private let kSymbolArgv = as_symbol(kValArgv) private let kSymbolConcat = as_symbol(kValConcat) @@ -76,9 +78,11 @@ private let kSymbolFn = as_symbol(kValFn) private let kSymbolIf = as_symbol(kValIf) private let kSymbolLet = as_symbol(kValLet) private let kSymbolQuasiQuote = as_symbol(kValQuasiQuote) +private let kSymbolQuasiQuoteExp = as_symbol(kValQuasiQuoteExp) private let kSymbolQuote = as_symbol(kValQuote) private let kSymbolSpliceUnquote = as_symbol(kValSpliceUnquote) private let kSymbolUnquote = as_symbol(kValUnquote) +private let kSymbolVec = as_symbol(kValVec) func substring(s: String, _ begin: Int, _ end: Int) -> String { return s[s.startIndex.advancedBy(begin) ..< s.startIndex.advancedBy(end)] @@ -90,62 +94,33 @@ private func READ(str: String) throws -> MalVal { return try read_str(str) } -// Return whether or not `val` is a non-empty list. +// Return whether or not `ast` is a list and first element is the required symbol. // -private func is_pair(val: MalVal) -> Bool { - if let seq = as_sequenceQ(val) { - return !seq.isEmpty +private func starts_with(ast: MalVal, sym: MalSymbol) -> MalVal? { + if let list = as_listQ(ast) where 1 < list.count, + let a0 = as_symbolQ(try! list.nth(0)) where a0 == sym { + return try! list.nth(1) + } else { + return nil } - return false } // Evaluate `quasiquote`, possibly recursing in the process. // -// As with quote, unquote, and splice-unquote, quasiquote takes a single -// parameter, typically a list. In the general case, this list is processed -// recursively as: -// -// (quasiquote (first rest...)) -> (cons (quasiquote first) (quasiquote rest)) -// -// In the processing of the parameter passed to it, quasiquote handles three -// special cases: -// -// * If the parameter is an atom or an empty list, the following expression -// is formed and returned for evaluation: -// -// (quasiquote atom-or-empty-list) -> (quote atom-or-empty-list) -// -// * If the first element of the non-empty list is the symbol "unquote" -// followed by a second item, the second item is returned as-is: -// -// (quasiquote (unquote fred)) -> fred -// -// * If the first element of the non-empty list is another list containing -// the symbol "splice-unquote" followed by a list, that list is catenated -// with the quasiquoted result of the remaining items in the non-empty -// parent list: -// -// (quasiquote (splice-unquote list) rest...) -> (items-from-list items-from-quasiquote(rest...)) -// -// Note the inconsistent handling between "quote" and "splice-quote". The former -// is handled when this function is handed a list that starts with "quote", -// whereas the latter is handled when this function is handled a list whose -// first element is a list that starts with "splice-quote". The handling of the -// latter is forced by the need to incorporate the results of (splice-quote -// list) with the remaining items of the list containing that splice-quote -// expression. However, it's not clear to me why the handling of "unquote" is -// not handled similarly, for consistency's sake. -// private func quasiquote(qq_arg: MalVal) throws -> MalVal { // If the argument is an atom or empty list: // // Return: (quote ) - if !is_pair(qq_arg) { + if is_symbol(qq_arg) || is_hashmap(qq_arg) { return make_list_from(kValQuote, qq_arg) } + guard let seq = as_sequenceQ(qq_arg) else { + return qq_arg + } + // The argument is a non-empty list -- that is (item rest...) // If the first item from the list is a symbol and it's "unquote" -- that @@ -153,31 +128,22 @@ private func quasiquote(qq_arg: MalVal) throws -> MalVal { // // Return: item - let qq_list = as_sequence(qq_arg) - if let sym = as_symbolQ(qq_list.first()) where sym == kSymbolUnquote { - return qq_list.count >= 2 ? try! qq_list.nth(1) : make_nil() + if let x = starts_with(qq_arg, sym: kSymbolUnquote) { + return x } - // If the first item from the list is itself a non-empty list starting with - // "splice-unquote"-- that is, ((splice-unquote item ignored...) rest...): - // - // Return: (concat item quasiquote(rest...)) - - if is_pair(qq_list.first()) { - let qq_list_item0 = as_sequence(qq_list.first()) - if let sym = as_symbolQ(qq_list_item0.first()) where sym == kSymbolSpliceUnquote { - let result = try quasiquote(qq_list.rest()) - return make_list_from(kValConcat, try! qq_list_item0.nth(1), result) + var result = make_list_from() + for elt in seq.reverse() { + if let x = starts_with(elt, sym: kSymbolSpliceUnquote) { + result = make_list_from(kValConcat, x, result) + } else { + result = make_list_from(kValCons, try quasiquote (elt), result) } } - - // General case: (item rest...): - // - // Return: (cons (quasiquote item) (quasiquote (rest...)) - - let first = try quasiquote(qq_list.first()) - let rest = try quasiquote(qq_list.rest()) - return make_list_from(kValCons, first, rest) + if is_vector(qq_arg) { + return make_list_from(kValVec, result) + } + return result } // Perform a simple evaluation of the `ast` object. If it's a symbol, @@ -333,6 +299,15 @@ private func eval_quote(list: MalSequence, _ env: Environment) throws -> TCOVal return TCOVal(make_nil()) } +// EVALuate "quasiquoteexpand". +// +private func eval_quasiquoteexp(list: MalSequence) throws -> TCOVal { + if list.count < 2 { + try throw_error("quasiquoteexpand: arg count") + } + return TCOVal(try! quasiquote(try! list.nth(1))) +} + // EVALuate "quasiquote". // private func eval_quasiquote(list: MalSequence, _ env: Environment) throws -> TCOVal { @@ -395,6 +370,7 @@ private func EVAL(var ast: MalVal, var _ env: Environment) throws -> MalVal { case kSymbolFn: res = try eval_fn(list, env) case kSymbolQuote: res = try eval_quote(list, env) case kSymbolQuasiQuote: res = try eval_quasiquote(list, env) + case kSymbolQuasiQuoteExp: res = try eval_quasiquoteexp(list) default: res = TCOVal() } switch res { diff --git a/impls/swift/step8_macros.swift b/impls/swift/step8_macros.swift index c2a288b5..81712ca6 100644 --- a/impls/swift/step8_macros.swift +++ b/impls/swift/step8_macros.swift @@ -63,10 +63,12 @@ private let kValIf = make_symbol("if") private let kValLet = make_symbol("let*") private let kValMacroExpand = make_symbol("macroexpand") private let kValQuasiQuote = make_symbol("quasiquote") +private let kValQuasiQuoteExp = make_symbol("quasiquoteexpand") private let kValQuote = make_symbol("quote") private let kValSpliceUnquote = make_symbol("splice-unquote") private let kValUnquote = make_symbol("unquote") private let kValTry = make_symbol("try*") +private let kValVec = make_symbol("vec") private let kSymbolArgv = as_symbol(kValArgv) private let kSymbolConcat = as_symbol(kValConcat) @@ -80,9 +82,11 @@ private let kSymbolIf = as_symbol(kValIf) private let kSymbolLet = as_symbol(kValLet) private let kSymbolMacroExpand = as_symbol(kValMacroExpand) private let kSymbolQuasiQuote = as_symbol(kValQuasiQuote) +private let kSymbolQuasiQuoteExp = as_symbol(kValQuasiQuoteExp) private let kSymbolQuote = as_symbol(kValQuote) private let kSymbolSpliceUnquote = as_symbol(kValSpliceUnquote) private let kSymbolUnquote = as_symbol(kValUnquote) +private let kSymbolVec = as_symbol(kValVec) func substring(s: String, _ begin: Int, _ end: Int) -> String { return s[s.startIndex.advancedBy(begin) ..< s.startIndex.advancedBy(end)] @@ -94,15 +98,6 @@ private func READ(str: String) throws -> MalVal { return try read_str(str) } -// Return whether or not `val` is a non-empty list. -// -private func is_pair(val: MalVal) -> Bool { - if let seq = as_sequenceQ(val) { - return !seq.isEmpty - } - return false -} - // Expand macros for as long as the expression looks like a macro invocation. // private func macroexpand(var ast: MalVal, _ env: Environment) throws -> MalVal { @@ -122,53 +117,33 @@ private func macroexpand(var ast: MalVal, _ env: Environment) throws -> MalVal { } } +// Return whether or not `ast` is a list and first element is the required symbol. +// +private func starts_with(ast: MalVal, sym: MalSymbol) -> MalVal? { + if let list = as_listQ(ast) where 1 < list.count, + let a0 = as_symbolQ(try! list.nth(0)) where a0 == sym { + return try! list.nth(1) + } else { + return nil + } +} + // Evaluate `quasiquote`, possibly recursing in the process. // -// As with quote, unquote, and splice-unquote, quasiquote takes a single -// parameter, typically a list. In the general case, this list is processed -// recursively as: -// -// (quasiquote (first rest...)) -> (cons (quasiquote first) (quasiquote rest)) -// -// In the processing of the parameter passed to it, quasiquote handles three -// special cases: -// -// * If the parameter is an atom or an empty list, the following expression -// is formed and returned for evaluation: -// -// (quasiquote atom-or-empty-list) -> (quote atom-or-empty-list) -// -// * If the first element of the non-empty list is the symbol "unquote" -// followed by a second item, the second item is returned as-is: -// -// (quasiquote (unquote fred)) -> fred -// -// * If the first element of the non-empty list is another list containing -// the symbol "splice-unquote" followed by a list, that list is catenated -// with the quasiquoted result of the remaining items in the non-empty -// parent list: -// -// (quasiquote (splice-unquote list) rest...) -> (items-from-list items-from-quasiquote(rest...)) -// -// Note the inconsistent handling between "quote" and "splice-quote". The former -// is handled when this function is handed a list that starts with "quote", -// whereas the latter is handled when this function is handled a list whose -// first element is a list that starts with "splice-quote". The handling of the -// latter is forced by the need to incorporate the results of (splice-quote -// list) with the remaining items of the list containing that splice-quote -// expression. However, it's not clear to me why the handling of "unquote" is -// not handled similarly, for consistency's sake. -// private func quasiquote(qq_arg: MalVal) throws -> MalVal { // If the argument is an atom or empty list: // // Return: (quote ) - if !is_pair(qq_arg) { + if is_symbol(qq_arg) || is_hashmap(qq_arg) { return make_list_from(kValQuote, qq_arg) } + guard let seq = as_sequenceQ(qq_arg) else { + return qq_arg + } + // The argument is a non-empty list -- that is (item rest...) // If the first item from the list is a symbol and it's "unquote" -- that @@ -176,31 +151,22 @@ private func quasiquote(qq_arg: MalVal) throws -> MalVal { // // Return: item - let qq_list = as_sequence(qq_arg) - if let sym = as_symbolQ(qq_list.first()) where sym == kSymbolUnquote { - return qq_list.count >= 2 ? try! qq_list.nth(1) : make_nil() + if let x = starts_with(qq_arg, sym: kSymbolUnquote) { + return x } - // If the first item from the list is itself a non-empty list starting with - // "splice-unquote"-- that is, ((splice-unquote item ignored...) rest...): - // - // Return: (concat item quasiquote(rest...)) - - if is_pair(qq_list.first()) { - let qq_list_item0 = as_sequence(qq_list.first()) - if let sym = as_symbolQ(qq_list_item0.first()) where sym == kSymbolSpliceUnquote { - let result = try quasiquote(qq_list.rest()) - return make_list_from(kValConcat, try! qq_list_item0.nth(1), result) + var result = make_list_from() + for elt in seq.reverse() { + if let x = starts_with(elt, sym: kSymbolSpliceUnquote) { + result = make_list_from(kValConcat, x, result) + } else { + result = make_list_from(kValCons, try quasiquote (elt), result) } } - - // General case: (item rest...): - // - // Return: (cons (quasiquote item) (quasiquote (rest...)) - - let first = try quasiquote(qq_list.first()) - let rest = try quasiquote(qq_list.rest()) - return make_list_from(kValCons, first, rest) + if is_vector(qq_arg) { + return make_list_from(kValVec, result) + } + return result } // Perform a simple evaluation of the `ast` object. If it's a symbol, @@ -363,6 +329,15 @@ private func eval_quote(list: MalSequence, _ env: Environment) throws -> TCOVal return TCOVal(make_nil()) } +// EVALuate "quasiquoteexpand". +// +private func eval_quasiquoteexp(list: MalSequence) throws -> TCOVal { + if list.count < 2 { + try throw_error("quasiquoteexpand: arg count") + } + return TCOVal(try! quasiquote(try! list.nth(1))) +} + // EVALuate "quasiquote". // private func eval_quasiquote(list: MalSequence, _ env: Environment) throws -> TCOVal { @@ -446,6 +421,7 @@ private func EVAL(var ast: MalVal, var _ env: Environment) throws -> MalVal { case kSymbolFn: res = try eval_fn(list, env) case kSymbolQuote: res = try eval_quote(list, env) case kSymbolQuasiQuote: res = try eval_quasiquote(list, env) + case kSymbolQuasiQuoteExp: res = try eval_quasiquoteexp(list) case kSymbolMacroExpand: res = try eval_macroexpand(list, env) default: res = TCOVal() } diff --git a/impls/swift/step9_try.swift b/impls/swift/step9_try.swift index 4c5cb9e2..79353923 100644 --- a/impls/swift/step9_try.swift +++ b/impls/swift/step9_try.swift @@ -64,10 +64,12 @@ private let kValIf = make_symbol("if") private let kValLet = make_symbol("let*") private let kValMacroExpand = make_symbol("macroexpand") private let kValQuasiQuote = make_symbol("quasiquote") +private let kValQuasiQuoteExp = make_symbol("quasiquoteexpand") private let kValQuote = make_symbol("quote") private let kValSpliceUnquote = make_symbol("splice-unquote") private let kValUnquote = make_symbol("unquote") private let kValTry = make_symbol("try*") +private let kValVec = make_symbol("vec") private let kSymbolArgv = as_symbol(kValArgv) private let kSymbolCatch = as_symbol(kValCatch) @@ -82,10 +84,12 @@ private let kSymbolIf = as_symbol(kValIf) private let kSymbolLet = as_symbol(kValLet) private let kSymbolMacroExpand = as_symbol(kValMacroExpand) private let kSymbolQuasiQuote = as_symbol(kValQuasiQuote) +private let kSymbolQuasiQuoteExp = as_symbol(kValQuasiQuoteExp) private let kSymbolQuote = as_symbol(kValQuote) private let kSymbolSpliceUnquote = as_symbol(kValSpliceUnquote) private let kSymbolUnquote = as_symbol(kValUnquote) private let kSymbolTry = as_symbol(kValTry) +private let kSymbolVec = as_symbol(kValVec) func substring(s: String, _ begin: Int, _ end: Int) -> String { return s[s.startIndex.advancedBy(begin) ..< s.startIndex.advancedBy(end)] @@ -97,15 +101,6 @@ private func READ(str: String) throws -> MalVal { return try read_str(str) } -// Return whether or not `val` is a non-empty list. -// -private func is_pair(val: MalVal) -> Bool { - if let seq = as_sequenceQ(val) { - return !seq.isEmpty - } - return false -} - // Expand macros for as long as the expression looks like a macro invocation. // private func macroexpand(var ast: MalVal, _ env: Environment) throws -> MalVal { @@ -125,53 +120,33 @@ private func macroexpand(var ast: MalVal, _ env: Environment) throws -> MalVal { } } +// Return whether or not `ast` is a list and first element is the required symbol. +// +private func starts_with(ast: MalVal, sym: MalSymbol) -> MalVal? { + if let list = as_listQ(ast) where 1 < list.count, + let a0 = as_symbolQ(try! list.nth(0)) where a0 == sym { + return try! list.nth(1) + } else { + return nil + } +} + // Evaluate `quasiquote`, possibly recursing in the process. // -// As with quote, unquote, and splice-unquote, quasiquote takes a single -// parameter, typically a list. In the general case, this list is processed -// recursively as: -// -// (quasiquote (first rest...)) -> (cons (quasiquote first) (quasiquote rest)) -// -// In the processing of the parameter passed to it, quasiquote handles three -// special cases: -// -// * If the parameter is an atom or an empty list, the following expression -// is formed and returned for evaluation: -// -// (quasiquote atom-or-empty-list) -> (quote atom-or-empty-list) -// -// * If the first element of the non-empty list is the symbol "unquote" -// followed by a second item, the second item is returned as-is: -// -// (quasiquote (unquote fred)) -> fred -// -// * If the first element of the non-empty list is another list containing -// the symbol "splice-unquote" followed by a list, that list is catenated -// with the quasiquoted result of the remaining items in the non-empty -// parent list: -// -// (quasiquote (splice-unquote list) rest...) -> (items-from-list items-from-quasiquote(rest...)) -// -// Note the inconsistent handling between "quote" and "splice-quote". The former -// is handled when this function is handed a list that starts with "quote", -// whereas the latter is handled when this function is handled a list whose -// first element is a list that starts with "splice-quote". The handling of the -// latter is forced by the need to incorporate the results of (splice-quote -// list) with the remaining items of the list containing that splice-quote -// expression. However, it's not clear to me why the handling of "unquote" is -// not handled similarly, for consistency's sake. -// private func quasiquote(qq_arg: MalVal) throws -> MalVal { // If the argument is an atom or empty list: // // Return: (quote ) - if !is_pair(qq_arg) { + if is_symbol(qq_arg) || is_hashmap(qq_arg) { return make_list_from(kValQuote, qq_arg) } + guard let seq = as_sequenceQ(qq_arg) else { + return qq_arg + } + // The argument is a non-empty list -- that is (item rest...) // If the first item from the list is a symbol and it's "unquote" -- that @@ -179,31 +154,22 @@ private func quasiquote(qq_arg: MalVal) throws -> MalVal { // // Return: item - let qq_list = as_sequence(qq_arg) - if let sym = as_symbolQ(qq_list.first()) where sym == kSymbolUnquote { - return qq_list.count >= 2 ? try! qq_list.nth(1) : make_nil() + if let x = starts_with(qq_arg, sym: kSymbolUnquote) { + return x } - // If the first item from the list is itself a non-empty list starting with - // "splice-unquote"-- that is, ((splice-unquote item ignored...) rest...): - // - // Return: (concat item quasiquote(rest...)) - - if is_pair(qq_list.first()) { - let qq_list_item0 = as_sequence(qq_list.first()) - if let sym = as_symbolQ(qq_list_item0.first()) where sym == kSymbolSpliceUnquote { - let result = try quasiquote(qq_list.rest()) - return make_list_from(kValConcat, try! qq_list_item0.nth(1), result) + var result = make_list_from() + for elt in seq.reverse() { + if let x = starts_with(elt, sym: kSymbolSpliceUnquote) { + result = make_list_from(kValConcat, x, result) + } else { + result = make_list_from(kValCons, try quasiquote (elt), result) } } - - // General case: (item rest...): - // - // Return: (cons (quasiquote item) (quasiquote (rest...)) - - let first = try quasiquote(qq_list.first()) - let rest = try quasiquote(qq_list.rest()) - return make_list_from(kValCons, first, rest) + if is_vector(qq_arg) { + return make_list_from(kValVec, result) + } + return result } // Perform a simple evaluation of the `ast` object. If it's a symbol, @@ -366,6 +332,15 @@ private func eval_quote(list: MalSequence, _ env: Environment) throws -> TCOVal return TCOVal(make_nil()) } +// EVALuate "quasiquoteexpand". +// +private func eval_quasiquoteexp(list: MalSequence) throws -> TCOVal { + if list.count < 2 { + try throw_error("quasiquoteexpand: arg count") + } + return TCOVal(try! quasiquote(try! list.nth(1))) +} + // EVALuate "quasiquote". // private func eval_quasiquote(list: MalSequence, _ env: Environment) throws -> TCOVal { @@ -478,6 +453,7 @@ private func EVAL(var ast: MalVal, var _ env: Environment) throws -> MalVal { case kSymbolFn: res = try eval_fn(list, env) case kSymbolQuote: res = try eval_quote(list, env) case kSymbolQuasiQuote: res = try eval_quasiquote(list, env) + case kSymbolQuasiQuoteExp: res = try eval_quasiquoteexp(list) case kSymbolMacroExpand: res = try eval_macroexpand(list, env) case kSymbolTry: res = try eval_try(list, env) default: res = TCOVal() diff --git a/impls/swift/stepA_mal.swift b/impls/swift/stepA_mal.swift index 33ab764c..96e93ece 100644 --- a/impls/swift/stepA_mal.swift +++ b/impls/swift/stepA_mal.swift @@ -64,10 +64,12 @@ private let kValIf = make_symbol("if") private let kValLet = make_symbol("let*") private let kValMacroExpand = make_symbol("macroexpand") private let kValQuasiQuote = make_symbol("quasiquote") +private let kValQuasiQuoteExp = make_symbol("quasiquoteexpand") private let kValQuote = make_symbol("quote") private let kValSpliceUnquote = make_symbol("splice-unquote") private let kValUnquote = make_symbol("unquote") private let kValTry = make_symbol("try*") +private let kValVec = make_symbol("vec") private let kSymbolArgv = as_symbol(kValArgv) private let kSymbolCatch = as_symbol(kValCatch) @@ -82,10 +84,12 @@ private let kSymbolIf = as_symbol(kValIf) private let kSymbolLet = as_symbol(kValLet) private let kSymbolMacroExpand = as_symbol(kValMacroExpand) private let kSymbolQuasiQuote = as_symbol(kValQuasiQuote) +private let kSymbolQuasiQuoteExp = as_symbol(kValQuasiQuoteExp) private let kSymbolQuote = as_symbol(kValQuote) private let kSymbolSpliceUnquote = as_symbol(kValSpliceUnquote) private let kSymbolUnquote = as_symbol(kValUnquote) private let kSymbolTry = as_symbol(kValTry) +private let kSymbolVec = as_symbol(kValVec) func substring(s: String, _ begin: Int, _ end: Int) -> String { return s[s.startIndex.advancedBy(begin) ..< s.startIndex.advancedBy(end)] @@ -97,15 +101,6 @@ private func READ(str: String) throws -> MalVal { return try read_str(str) } -// Return whether or not `val` is a non-empty list. -// -private func is_pair(val: MalVal) -> Bool { - if let seq = as_sequenceQ(val) { - return !seq.isEmpty - } - return false -} - // Expand macros for as long as the expression looks like a macro invocation. // private func macroexpand(var ast: MalVal, _ env: Environment) throws -> MalVal { @@ -125,53 +120,33 @@ private func macroexpand(var ast: MalVal, _ env: Environment) throws -> MalVal { } } +// Return whether or not `ast` is a list and first element is the required symbol. +// +private func starts_with(ast: MalVal, sym: MalSymbol) -> MalVal? { + if let list = as_listQ(ast) where 1 < list.count, + let a0 = as_symbolQ(try! list.nth(0)) where a0 == sym { + return try! list.nth(1) + } else { + return nil + } +} + // Evaluate `quasiquote`, possibly recursing in the process. // -// As with quote, unquote, and splice-unquote, quasiquote takes a single -// parameter, typically a list. In the general case, this list is processed -// recursively as: -// -// (quasiquote (first rest...)) -> (cons (quasiquote first) (quasiquote rest)) -// -// In the processing of the parameter passed to it, quasiquote handles three -// special cases: -// -// * If the parameter is an atom or an empty list, the following expression -// is formed and returned for evaluation: -// -// (quasiquote atom-or-empty-list) -> (quote atom-or-empty-list) -// -// * If the first element of the non-empty list is the symbol "unquote" -// followed by a second item, the second item is returned as-is: -// -// (quasiquote (unquote fred)) -> fred -// -// * If the first element of the non-empty list is another list containing -// the symbol "splice-unquote" followed by a list, that list is catenated -// with the quasiquoted result of the remaining items in the non-empty -// parent list: -// -// (quasiquote (splice-unquote list) rest...) -> (items-from-list items-from-quasiquote(rest...)) -// -// Note the inconsistent handling between "quote" and "splice-quote". The former -// is handled when this function is handed a list that starts with "quote", -// whereas the latter is handled when this function is handled a list whose -// first element is a list that starts with "splice-quote". The handling of the -// latter is forced by the need to incorporate the results of (splice-quote -// list) with the remaining items of the list containing that splice-quote -// expression. However, it's not clear to me why the handling of "unquote" is -// not handled similarly, for consistency's sake. -// private func quasiquote(qq_arg: MalVal) throws -> MalVal { // If the argument is an atom or empty list: // // Return: (quote ) - if !is_pair(qq_arg) { + if is_symbol(qq_arg) || is_hashmap(qq_arg) { return make_list_from(kValQuote, qq_arg) } + guard let seq = as_sequenceQ(qq_arg) else { + return qq_arg + } + // The argument is a non-empty list -- that is (item rest...) // If the first item from the list is a symbol and it's "unquote" -- that @@ -179,31 +154,22 @@ private func quasiquote(qq_arg: MalVal) throws -> MalVal { // // Return: item - let qq_list = as_sequence(qq_arg) - if let sym = as_symbolQ(qq_list.first()) where sym == kSymbolUnquote { - return qq_list.count >= 2 ? try! qq_list.nth(1) : make_nil() + if let x = starts_with(qq_arg, sym: kSymbolUnquote) { + return x } - // If the first item from the list is itself a non-empty list starting with - // "splice-unquote"-- that is, ((splice-unquote item ignored...) rest...): - // - // Return: (concat item quasiquote(rest...)) - - if is_pair(qq_list.first()) { - let qq_list_item0 = as_sequence(qq_list.first()) - if let sym = as_symbolQ(qq_list_item0.first()) where sym == kSymbolSpliceUnquote { - let result = try quasiquote(qq_list.rest()) - return make_list_from(kValConcat, try! qq_list_item0.nth(1), result) + var result = make_list_from() + for elt in seq.reverse() { + if let x = starts_with(elt, sym: kSymbolSpliceUnquote) { + result = make_list_from(kValConcat, x, result) + } else { + result = make_list_from(kValCons, try quasiquote (elt), result) } } - - // General case: (item rest...): - // - // Return: (cons (quasiquote item) (quasiquote (rest...)) - - let first = try quasiquote(qq_list.first()) - let rest = try quasiquote(qq_list.rest()) - return make_list_from(kValCons, first, rest) + if is_vector(qq_arg) { + return make_list_from(kValVec, result) + } + return result } // Perform a simple evaluation of the `ast` object. If it's a symbol, @@ -366,6 +332,15 @@ private func eval_quote(list: MalSequence, _ env: Environment) throws -> TCOVal return TCOVal(make_nil()) } +// EVALuate "quasiquoteexpand". +// +private func eval_quasiquoteexp(list: MalSequence) throws -> TCOVal { + if list.count < 2 { + try throw_error("quasiquoteexpand: arg count") + } + return TCOVal(try! quasiquote(try! list.nth(1))) +} + // EVALuate "quasiquote". // private func eval_quasiquote(list: MalSequence, _ env: Environment) throws -> TCOVal { @@ -478,6 +453,7 @@ private func EVAL(var ast: MalVal, var _ env: Environment) throws -> MalVal { case kSymbolFn: res = try eval_fn(list, env) case kSymbolQuote: res = try eval_quote(list, env) case kSymbolQuasiQuote: res = try eval_quasiquote(list, env) + case kSymbolQuasiQuoteExp: res = try eval_quasiquoteexp(list) case kSymbolMacroExpand: res = try eval_macroexpand(list, env) case kSymbolTry: res = try eval_try(list, env) default: res = TCOVal() diff --git a/impls/swift3/Sources/core.swift b/impls/swift3/Sources/core.swift index dcf5e300..be44f35c 100644 --- a/impls/swift3/Sources/core.swift +++ b/impls/swift3/Sources/core.swift @@ -272,6 +272,14 @@ let core_ns: Dictionary) throws -> MalVal> = [ } return list(res) }, + "vec": { + if $0.count != 1 { throw MalError.General(msg: "Invalid vec call") } + switch $0[0] { + case MV.MalList (let lst, _): return vector(lst) + case MV.MalVector(let lst, _): return vector(lst) + default: throw MalError.General(msg: "Invalid vec call") + } + }, "nth": { if $0.count != 2 { throw MalError.General(msg: "Invalid nth call") } switch ($0[0], $0[1]) { diff --git a/impls/swift3/Sources/step7_quote/main.swift b/impls/swift3/Sources/step7_quote/main.swift index 37447cae..e878750a 100644 --- a/impls/swift3/Sources/step7_quote/main.swift +++ b/impls/swift3/Sources/step7_quote/main.swift @@ -6,38 +6,49 @@ func READ(_ str: String) throws -> MalVal { } // eval -func is_pair(_ ast: MalVal) -> Bool { + +func starts_with(_ ast: MalVal, _ sym: String) -> MalVal? { switch ast { - case MalVal.MalList(let lst, _): return lst.count > 0 - case MalVal.MalVector(let lst, _): return lst.count > 0 - default: return false + case MalVal.MalList(let lst, _) where 1 < lst.count: + switch lst[0] { + case MalVal.MalSymbol(sym): + return lst[1] + default: + return nil + } + default: + return nil } } -func quasiquote(_ ast: MalVal) -> MalVal { - if !is_pair(ast) { - return list([MalVal.MalSymbol("quote"), ast]) - } - let a0 = try! _nth(ast, 0) - switch a0 { - case MalVal.MalSymbol("unquote"): - return try! _nth(ast, 1) - default: break - } - if is_pair(a0) { - let a00 = try! _nth(a0, 0) - switch a00 { - case MalVal.MalSymbol("splice-unquote"): - return list([MalVal.MalSymbol("concat"), - try! _nth(a0, 1), - quasiquote(try! rest(ast))]) - default: break - } +func qqIter(_ lst: [MalVal]) -> MalVal { + var result = list([]) + for elt in lst.reversed() { + if let elt1 = starts_with(elt, "splice-unquote") { + result = list([MalVal.MalSymbol("concat"), elt1, result]) + } else { + result = list([MalVal.MalSymbol("cons"), quasiquote(elt), result]) + } } + return result +} - return list([MalVal.MalSymbol("cons"), - quasiquote(a0), - quasiquote(try! rest(ast))]) +func quasiquote(_ ast: MalVal) -> MalVal { + if let a1 = starts_with(ast, "unquote") { + return a1 + } + switch ast { + case MalVal.MalList(let lst, _): + return qqIter(lst) + case MalVal.MalVector(let lst, _): + return list([MalVal.MalSymbol("vec"), qqIter(lst)]) + case MalVal.MalSymbol: + return list([MalVal.MalSymbol("quote"), ast]) + case MalVal.MalHashMap: + return list([MalVal.MalSymbol("quote"), ast]) + default: + return ast + } } func eval_ast(_ ast: MalVal, _ env: Env) throws -> MalVal { @@ -89,6 +100,8 @@ func EVAL(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { ast = lst[2] // TCO case MalVal.MalSymbol("quote"): return lst[1] + case MalVal.MalSymbol("quasiquoteexpand"): + return quasiquote(lst[1]) case MalVal.MalSymbol("quasiquote"): ast = quasiquote(lst[1]) // TCO case MalVal.MalSymbol("do"): diff --git a/impls/swift3/Sources/step8_macros/main.swift b/impls/swift3/Sources/step8_macros/main.swift index b15332e5..970fa2a8 100644 --- a/impls/swift3/Sources/step8_macros/main.swift +++ b/impls/swift3/Sources/step8_macros/main.swift @@ -6,38 +6,49 @@ func READ(_ str: String) throws -> MalVal { } // eval -func is_pair(_ ast: MalVal) -> Bool { + +func starts_with(_ ast: MalVal, _ sym: String) -> MalVal? { switch ast { - case MalVal.MalList(let lst, _): return lst.count > 0 - case MalVal.MalVector(let lst, _): return lst.count > 0 - default: return false + case MalVal.MalList(let lst, _) where 1 < lst.count: + switch lst[0] { + case MalVal.MalSymbol(sym): + return lst[1] + default: + return nil + } + default: + return nil } } -func quasiquote(_ ast: MalVal) -> MalVal { - if !is_pair(ast) { - return list([MalVal.MalSymbol("quote"), ast]) - } - let a0 = try! _nth(ast, 0) - switch a0 { - case MalVal.MalSymbol("unquote"): - return try! _nth(ast, 1) - default: break - } - if is_pair(a0) { - let a00 = try! _nth(a0, 0) - switch a00 { - case MalVal.MalSymbol("splice-unquote"): - return list([MalVal.MalSymbol("concat"), - try! _nth(a0, 1), - quasiquote(try! rest(ast))]) - default: break - } +func qqIter(_ lst: [MalVal]) -> MalVal { + var result = list([]) + for elt in lst.reversed() { + if let elt1 = starts_with(elt, "splice-unquote") { + result = list([MalVal.MalSymbol("concat"), elt1, result]) + } else { + result = list([MalVal.MalSymbol("cons"), quasiquote(elt), result]) + } } + return result +} - return list([MalVal.MalSymbol("cons"), - quasiquote(a0), - quasiquote(try! rest(ast))]) +func quasiquote(_ ast: MalVal) -> MalVal { + if let a1 = starts_with(ast, "unquote") { + return a1 + } + switch ast { + case MalVal.MalList(let lst, _): + return qqIter(lst) + case MalVal.MalVector(let lst, _): + return list([MalVal.MalSymbol("vec"), qqIter(lst)]) + case MalVal.MalSymbol: + return list([MalVal.MalSymbol("quote"), ast]) + case MalVal.MalHashMap: + return list([MalVal.MalSymbol("quote"), ast]) + default: + return ast + } } func is_macro(_ ast: MalVal, _ env: Env) -> Bool { @@ -129,6 +140,8 @@ func EVAL(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { ast = lst[2] // TCO case MalVal.MalSymbol("quote"): return lst[1] + case MalVal.MalSymbol("quasiquoteexpand"): + return quasiquote(lst[1]) case MalVal.MalSymbol("quasiquote"): ast = quasiquote(lst[1]) // TCO case MalVal.MalSymbol("defmacro!"): diff --git a/impls/swift3/Sources/step9_try/main.swift b/impls/swift3/Sources/step9_try/main.swift index ce2ba65c..35155391 100644 --- a/impls/swift3/Sources/step9_try/main.swift +++ b/impls/swift3/Sources/step9_try/main.swift @@ -6,38 +6,49 @@ func READ(_ str: String) throws -> MalVal { } // eval -func is_pair(_ ast: MalVal) -> Bool { + +func starts_with(_ ast: MalVal, _ sym: String) -> MalVal? { switch ast { - case MalVal.MalList(let lst, _): return lst.count > 0 - case MalVal.MalVector(let lst, _): return lst.count > 0 - default: return false + case MalVal.MalList(let lst, _) where 1 < lst.count: + switch lst[0] { + case MalVal.MalSymbol(sym): + return lst[1] + default: + return nil + } + default: + return nil } } -func quasiquote(_ ast: MalVal) -> MalVal { - if !is_pair(ast) { - return list([MalVal.MalSymbol("quote"), ast]) - } - let a0 = try! _nth(ast, 0) - switch a0 { - case MalVal.MalSymbol("unquote"): - return try! _nth(ast, 1) - default: break - } - if is_pair(a0) { - let a00 = try! _nth(a0, 0) - switch a00 { - case MalVal.MalSymbol("splice-unquote"): - return list([MalVal.MalSymbol("concat"), - try! _nth(a0, 1), - quasiquote(try! rest(ast))]) - default: break - } +func qqIter(_ lst: [MalVal]) -> MalVal { + var result = list([]) + for elt in lst.reversed() { + if let elt1 = starts_with(elt, "splice-unquote") { + result = list([MalVal.MalSymbol("concat"), elt1, result]) + } else { + result = list([MalVal.MalSymbol("cons"), quasiquote(elt), result]) + } } + return result +} - return list([MalVal.MalSymbol("cons"), - quasiquote(a0), - quasiquote(try! rest(ast))]) +func quasiquote(_ ast: MalVal) -> MalVal { + if let a1 = starts_with(ast, "unquote") { + return a1 + } + switch ast { + case MalVal.MalList(let lst, _): + return qqIter(lst) + case MalVal.MalVector(let lst, _): + return list([MalVal.MalSymbol("vec"), qqIter(lst)]) + case MalVal.MalSymbol: + return list([MalVal.MalSymbol("quote"), ast]) + case MalVal.MalHashMap: + return list([MalVal.MalSymbol("quote"), ast]) + default: + return ast + } } func is_macro(_ ast: MalVal, _ env: Env) -> Bool { @@ -129,6 +140,8 @@ func EVAL(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { ast = lst[2] // TCO case MalVal.MalSymbol("quote"): return lst[1] + case MalVal.MalSymbol("quasiquoteexpand"): + return quasiquote(lst[1]) case MalVal.MalSymbol("quasiquote"): ast = quasiquote(lst[1]) // TCO case MalVal.MalSymbol("defmacro!"): diff --git a/impls/swift3/Sources/stepA_mal/main.swift b/impls/swift3/Sources/stepA_mal/main.swift index 3473ec19..d743338e 100644 --- a/impls/swift3/Sources/stepA_mal/main.swift +++ b/impls/swift3/Sources/stepA_mal/main.swift @@ -6,38 +6,49 @@ func READ(_ str: String) throws -> MalVal { } // eval -func is_pair(_ ast: MalVal) -> Bool { + +func starts_with(_ ast: MalVal, _ sym: String) -> MalVal? { switch ast { - case MalVal.MalList(let lst, _): return lst.count > 0 - case MalVal.MalVector(let lst, _): return lst.count > 0 - default: return false + case MalVal.MalList(let lst, _) where 1 < lst.count: + switch lst[0] { + case MalVal.MalSymbol(sym): + return lst[1] + default: + return nil + } + default: + return nil } } -func quasiquote(_ ast: MalVal) -> MalVal { - if !is_pair(ast) { - return list([MalVal.MalSymbol("quote"), ast]) - } - let a0 = try! _nth(ast, 0) - switch a0 { - case MalVal.MalSymbol("unquote"): - return try! _nth(ast, 1) - default: break - } - if is_pair(a0) { - let a00 = try! _nth(a0, 0) - switch a00 { - case MalVal.MalSymbol("splice-unquote"): - return list([MalVal.MalSymbol("concat"), - try! _nth(a0, 1), - quasiquote(try! rest(ast))]) - default: break - } +func qqIter(_ lst: [MalVal]) -> MalVal { + var result = list([]) + for elt in lst.reversed() { + if let elt1 = starts_with(elt, "splice-unquote") { + result = list([MalVal.MalSymbol("concat"), elt1, result]) + } else { + result = list([MalVal.MalSymbol("cons"), quasiquote(elt), result]) + } } + return result +} - return list([MalVal.MalSymbol("cons"), - quasiquote(a0), - quasiquote(try! rest(ast))]) +func quasiquote(_ ast: MalVal) -> MalVal { + if let a1 = starts_with(ast, "unquote") { + return a1 + } + switch ast { + case MalVal.MalList(let lst, _): + return qqIter(lst) + case MalVal.MalVector(let lst, _): + return list([MalVal.MalSymbol("vec"), qqIter(lst)]) + case MalVal.MalSymbol: + return list([MalVal.MalSymbol("quote"), ast]) + case MalVal.MalHashMap: + return list([MalVal.MalSymbol("quote"), ast]) + default: + return ast + } } func is_macro(_ ast: MalVal, _ env: Env) -> Bool { @@ -129,6 +140,8 @@ func EVAL(_ orig_ast: MalVal, _ orig_env: Env) throws -> MalVal { ast = lst[2] // TCO case MalVal.MalSymbol("quote"): return lst[1] + case MalVal.MalSymbol("quasiquoteexpand"): + return quasiquote(lst[1]) case MalVal.MalSymbol("quasiquote"): ast = quasiquote(lst[1]) // TCO case MalVal.MalSymbol("defmacro!"): diff --git a/impls/swift4/Sources/core.swift b/impls/swift4/Sources/core.swift index 38212988..e10fe5af 100644 --- a/impls/swift4/Sources/core.swift +++ b/impls/swift4/Sources/core.swift @@ -94,6 +94,7 @@ let ns: [String: ([MalData]) throws -> MalData] = }, "cons": { args in [args[0]] + args[1].listForm }, "concat": { $0.reduce([]) { (result, array ) in result + array.listForm } }, + "vec": { Vector($0[0].listForm) }, "nth": { args in let list = args[0].listForm, i = args[1] as! Int diff --git a/impls/swift4/Sources/step7_quote/main.swift b/impls/swift4/Sources/step7_quote/main.swift index efa4af51..a5e7a3eb 100644 --- a/impls/swift4/Sources/step7_quote/main.swift +++ b/impls/swift4/Sources/step7_quote/main.swift @@ -5,25 +5,49 @@ func READ(_ input: String) throws -> MalData { return try read_str(input) } -func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { - func is_pair(_ ast: MalData) -> Bool { // not used - return (ast is [MalData]) && (ast.count != 0) - } - func quasiquote(_ ast: MalData) -> MalData { - let list = ast.listForm - if list.isEmpty { - return [Symbol("quote"), ast] - } - if let sym = list[0] as? Symbol, sym.name == "unquote" { - return list[1] - } - let innerList = list[0].listForm - if !innerList.isEmpty, let sym = innerList[0] as? Symbol, sym.name == "splice-unquote" { - return [Symbol("concat"), innerList[1], quasiquote(list.dropFirst().listForm)] - } - return [Symbol("cons"), quasiquote(list[0]), quasiquote(list.dropFirst().listForm)] +func starts_with(_ ast: MalData, _ sym: String) -> MalData? { + if let list = ast as? [MalData], + 2 == list.count, + let a0 = list[0] as? Symbol, + a0.name == sym { + return list[1] + } else { + return nil } +} +func qqIter(_ lst: [MalData]) -> MalData { + var result:MalData = [] + for elt in lst.reversed() { + if let x = starts_with(elt, "splice-unquote") { + result = [Symbol("concat"), x, result] + } else { + result = [Symbol("cons"), quasiquote(elt), result] + } + } + return result +} + +func quasiquote(_ ast: MalData) -> MalData { + switch ast.dataType { + case .List: + if let x = starts_with(ast, "unquote") { + return x + } else { + return qqIter (ast.listForm) + } + case .Vector: + return [Symbol("vec"), qqIter (ast.listForm)] + case .Symbol: + return [Symbol("quote"), ast] + case .HashMap: + return [Symbol("quote"), ast] + default: + return ast + } +} + +func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { var ast = anAst, env = anEnv while true { switch ast.dataType { @@ -67,6 +91,8 @@ func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) case "quote": return list[1] + case "quasiquoteexpand": + return quasiquote(list[1]) case "quasiquote": ast = quasiquote(list[1]) continue diff --git a/impls/swift4/Sources/step8_macros/main.swift b/impls/swift4/Sources/step8_macros/main.swift index 82c69a60..afd08a4b 100644 --- a/impls/swift4/Sources/step8_macros/main.swift +++ b/impls/swift4/Sources/step8_macros/main.swift @@ -5,24 +5,49 @@ func READ(_ input: String) throws -> MalData { return try read_str(input) } +func starts_with(_ ast: MalData, _ sym: String) -> MalData? { + if let list = ast as? [MalData], + 2 == list.count, + let a0 = list[0] as? Symbol, + a0.name == sym { + return list[1] + } else { + return nil + } +} + +func qqIter(_ lst: [MalData]) -> MalData { + var result:MalData = [] + for elt in lst.reversed() { + if let x = starts_with(elt, "splice-unquote") { + result = [Symbol("concat"), x, result] + } else { + result = [Symbol("cons"), quasiquote(elt), result] + } + } + return result +} + +func quasiquote(_ ast: MalData) -> MalData { + switch ast.dataType { + case .List: + if let x = starts_with(ast, "unquote") { + return x + } else { + return qqIter (ast.listForm) + } + case .Vector: + return [Symbol("vec"), qqIter (ast.listForm)] + case .Symbol: + return [Symbol("quote"), ast] + case .HashMap: + return [Symbol("quote"), ast] + default: + return ast + } +} + func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { - func is_pair(_ ast: MalData) -> Bool { // not used - return (ast is [MalData]) && (ast.count != 0) - } - func quasiquote(_ ast: MalData) -> MalData { - let list = ast.listForm - if list.isEmpty { - return [Symbol("quote"), ast] - } - if let sym = list[0] as? Symbol, sym.name == "unquote" { - return list[1] - } - let innerList = list[0].listForm - if !innerList.isEmpty, let sym = innerList[0] as? Symbol, sym.name == "splice-unquote" { - return [Symbol("concat"), innerList[1], quasiquote(list.dropFirst().listForm)] - } - return [Symbol("cons"), quasiquote(list[0]), quasiquote(list.dropFirst().listForm)] - } func macroexpand(_ anAst: MalData, env: Env) throws -> MalData { func isMacro_call(_ ast: MalData, env: Env) -> Bool { // not used if let list = ast as? [MalData], @@ -94,6 +119,8 @@ func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) case "quote": return list[1] + case "quasiquoteexpand": + return quasiquote(list[1]) case "quasiquote": ast = quasiquote(list[1]) continue diff --git a/impls/swift4/Sources/step9_try/main.swift b/impls/swift4/Sources/step9_try/main.swift index 857dcfd2..39283293 100644 --- a/impls/swift4/Sources/step9_try/main.swift +++ b/impls/swift4/Sources/step9_try/main.swift @@ -5,24 +5,49 @@ func READ(_ input: String) throws -> MalData { return try read_str(input) } +func starts_with(_ ast: MalData, _ sym: String) -> MalData? { + if let list = ast as? [MalData], + 2 == list.count, + let a0 = list[0] as? Symbol, + a0.name == sym { + return list[1] + } else { + return nil + } +} + +func qqIter(_ lst: [MalData]) -> MalData { + var result:MalData = [] + for elt in lst.reversed() { + if let x = starts_with(elt, "splice-unquote") { + result = [Symbol("concat"), x, result] + } else { + result = [Symbol("cons"), quasiquote(elt), result] + } + } + return result +} + +func quasiquote(_ ast: MalData) -> MalData { + switch ast.dataType { + case .List: + if let x = starts_with(ast, "unquote") { + return x + } else { + return qqIter (ast.listForm) + } + case .Vector: + return [Symbol("vec"), qqIter (ast.listForm)] + case .Symbol: + return [Symbol("quote"), ast] + case .HashMap: + return [Symbol("quote"), ast] + default: + return ast + } +} + func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { - func is_pair(_ ast: MalData) -> Bool { // not used - return (ast is [MalData]) && (ast.count != 0) - } - func quasiquote(_ ast: MalData) -> MalData { - let list = ast.listForm - if list.isEmpty { - return [Symbol("quote"), ast] - } - if let sym = list[0] as? Symbol, sym.name == "unquote" { - return list[1] - } - let innerList = list[0].listForm - if !innerList.isEmpty, let sym = innerList[0] as? Symbol, sym.name == "splice-unquote" { - return [Symbol("concat"), innerList[1], quasiquote(list.dropFirst().listForm)] - } - return [Symbol("cons"), quasiquote(list[0]), quasiquote(list.dropFirst().listForm)] - } func macroexpand(_ anAst: MalData, env: Env) throws -> MalData { func isMacro_call(_ ast: MalData, env: Env) -> Bool { // not used if let list = ast as? [MalData], @@ -94,6 +119,8 @@ func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) case "quote": return list[1] + case "quasiquoteexpand": + return quasiquote(list[1]) case "quasiquote": ast = quasiquote(list[1]) continue diff --git a/impls/swift4/Sources/stepA_mal/main.swift b/impls/swift4/Sources/stepA_mal/main.swift index 9c6192ad..07580b3d 100644 --- a/impls/swift4/Sources/stepA_mal/main.swift +++ b/impls/swift4/Sources/stepA_mal/main.swift @@ -5,24 +5,49 @@ func READ(_ input: String) throws -> MalData { return try read_str(input) } +func starts_with(_ ast: MalData, _ sym: String) -> MalData? { + if let list = ast as? [MalData], + 2 == list.count, + let a0 = list[0] as? Symbol, + a0.name == sym { + return list[1] + } else { + return nil + } +} + +func qqIter(_ lst: [MalData]) -> MalData { + var result:MalData = [] + for elt in lst.reversed() { + if let x = starts_with(elt, "splice-unquote") { + result = [Symbol("concat"), x, result] + } else { + result = [Symbol("cons"), quasiquote(elt), result] + } + } + return result +} + +func quasiquote(_ ast: MalData) -> MalData { + switch ast.dataType { + case .List: + if let x = starts_with(ast, "unquote") { + return x + } else { + return qqIter (ast.listForm) + } + case .Vector: + return [Symbol("vec"), qqIter (ast.listForm)] + case .Symbol: + return [Symbol("quote"), ast] + case .HashMap: + return [Symbol("quote"), ast] + default: + return ast + } +} + func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { - func is_pair(_ ast: MalData) -> Bool { // not used - return (ast is [MalData]) && (ast.count != 0) - } - func quasiquote(_ ast: MalData) -> MalData { - let list = ast.listForm - if list.isEmpty { - return [Symbol("quote"), ast] - } - if let sym = list[0] as? Symbol, sym.name == "unquote" { - return list[1] - } - let innerList = list[0].listForm - if !innerList.isEmpty, let sym = innerList[0] as? Symbol, sym.name == "splice-unquote" { - return [Symbol("concat"), innerList[1], quasiquote(list.dropFirst().listForm)] - } - return [Symbol("cons"), quasiquote(list[0]), quasiquote(list.dropFirst().listForm)] - } func macroexpand(_ anAst: MalData, env: Env) throws -> MalData { func isMacro_call(_ ast: MalData, env: Env) -> Bool { // not used if let list = ast as? [MalData], @@ -94,6 +119,8 @@ func EVAL(_ anAst: MalData, env anEnv: Env) throws -> MalData { return Function(ast: list[2], params: (list[1].listForm as! [Symbol]), env:env , fn: fn) case "quote": return list[1] + case "quasiquoteexpand": + return quasiquote(list[1]) case "quasiquote": ast = quasiquote(list[1]) continue diff --git a/impls/swift5/Sources/core/Core.swift b/impls/swift5/Sources/core/Core.swift index 0b67a39d..a30c9f37 100644 --- a/impls/swift5/Sources/core/Core.swift +++ b/impls/swift5/Sources/core/Core.swift @@ -161,6 +161,18 @@ private extension Func { return .list(values) } + static let vec = Func { args in + guard args.count == 1 else { throw MalError.invalidArguments("vec") } + switch args[0] { + case let .list(values, _): + return .vector(values) + case let .vector(values, _): + return args[0] + default: + throw MalError.invalidArguments("vec") + } + } + static let nth = Func { args in guard args.count == 2 else { throw MalError.invalidArguments("nth") } guard case let .number(index) = args[1] else { throw MalError.invalidArguments("nth") } @@ -513,6 +525,7 @@ private let data: [String: Expr] = [ "swap!": .function(.swap), "cons": .function(.cons), "concat": .function(.concat), + "vec": .function(.vec), "nth": .function(.nth), "first": .function(.first), "rest": .function(.rest), diff --git a/impls/swift5/Sources/step7_quote/main.swift b/impls/swift5/Sources/step7_quote/main.swift index 58da022a..5dacab42 100644 --- a/impls/swift5/Sources/step7_quote/main.swift +++ b/impls/swift5/Sources/step7_quote/main.swift @@ -5,47 +5,38 @@ func read(_ s: String) throws -> Expr { return try Reader.read(s) } -private func isPair(_ expr: Expr) -> Bool { - switch expr { - case let .list(values, _), let .vector(values, _): - return !values.isEmpty - default: - return false - } -} - -private func asListOrVector(_ expr: Expr) -> [Expr]? { - switch expr { - case let .list(values, _), let .vector(values, _): - return values - default: - return nil - } -} - -private func quasiquote(_ expr: Expr) throws -> Expr { - if !isPair(expr) { - return .list([.symbol("quote"), expr]) - } - guard let ast = asListOrVector(expr), !ast.isEmpty else { - throw MalError.invalidArguments("quasiquote") - } - - if case .symbol("unquote") = ast[0] { - guard ast.count > 1 else { throw MalError.invalidArguments("unquote") } - return ast[1] - } - - if isPair(ast[0]), let ast0 = asListOrVector(ast[0]) { - if case .symbol("splice-unquote") = ast0.first { - guard ast0.count > 1 else { throw MalError.invalidArguments("splice-unquote") } - let rest = try quasiquote(.list(Array(ast[1...]))) - return .list([.symbol("concat"), ast0[1], rest]) +private func qq_loop(_ elt: Expr, acc: Expr) throws -> Expr { + if case let .list(xs, _) = elt { + if 0 < xs.count && xs[0] == .symbol("splice-unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("splice-unquote") } + return .list([.symbol("concat"), xs[1], acc]) } } - - let rest = try quasiquote(.list(Array(ast[1...]))) - return .list([.symbol("cons"), try quasiquote(ast[0]), rest]) + return .list([.symbol("cons"), try quasiquote(elt), acc]) +} +private func qq_foldr(_ xs: [Expr]) throws -> Expr { + var acc : Expr = .list([]) + for i in stride(from: xs.count-1, through: 0, by: -1) { + acc = try qq_loop(xs[i], acc:acc) + } + return acc +} +private func quasiquote(_ expr: Expr) throws -> Expr { + switch expr { + case let .list(xs, _): + if 0 < xs.count && xs[0] == .symbol("unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("unquote") } + return xs[1] + } else { + return try qq_foldr(xs) + } + case let .vector(xs, _): + return .list([.symbol("vec"), try qq_foldr(xs)]) + case .symbol(_), .hashmap(_): + return .list([.symbol("quote"), expr]) + default: + return expr + } } private func evalAst(_ expr: Expr, env: Env) throws -> Expr { @@ -110,6 +101,10 @@ func eval(_ expr: Expr, env: Env) throws -> Expr { guard ast.count == 2 else { throw MalError.invalidArguments("quote") } return ast[1] + case .symbol("quasiquoteexpand"): + guard ast.count == 2 else { throw MalError.invalidArguments("quasiquoteexpand") } + return try quasiquote(ast[1]) + case .symbol("quasiquote"): guard ast.count == 2 else { throw MalError.invalidArguments("quasiquote") } expr = try quasiquote(ast[1]) diff --git a/impls/swift5/Sources/step8_macros/main.swift b/impls/swift5/Sources/step8_macros/main.swift index a05f3241..9998ab62 100644 --- a/impls/swift5/Sources/step8_macros/main.swift +++ b/impls/swift5/Sources/step8_macros/main.swift @@ -5,56 +5,38 @@ func read(_ s: String) throws -> Expr { return try Reader.read(s) } -private func isPair(_ expr: Expr) -> Bool { - switch expr { - case let .list(values, _), let .vector(values, _): - return !values.isEmpty - default: - return false - } -} - -private func asListOrVector(_ expr: Expr) -> [Expr]? { - switch expr { - case let .list(values, _), let .vector(values, _): - return values - default: - return nil - } -} - -private func quasiquote(_ expr: Expr) throws -> Expr { - if !isPair(expr) { - return .list([.symbol("quote"), expr]) - } - guard let ast = asListOrVector(expr), !ast.isEmpty else { - throw MalError.invalidArguments("quasiquote") - } - - if case .symbol("unquote") = ast[0] { - guard ast.count > 1 else { throw MalError.invalidArguments("unquote") } - return ast[1] - } - - if isPair(ast[0]), let ast0 = asListOrVector(ast[0]) { - if case .symbol("splice-unquote") = ast0.first { - guard ast0.count > 1 else { throw MalError.invalidArguments("splice-unquote") } - let rest = try quasiquote(.list(Array(ast[1...]))) - return .list([.symbol("concat"), ast0[1], rest]) +private func qq_loop(_ elt: Expr, acc: Expr) throws -> Expr { + if case let .list(xs, _) = elt { + if 0 < xs.count && xs[0] == .symbol("splice-unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("splice-unquote") } + return .list([.symbol("concat"), xs[1], acc]) } } - - let rest = try quasiquote(.list(Array(ast[1...]))) - return .list([.symbol("cons"), try quasiquote(ast[0]), rest]) + return .list([.symbol("cons"), try quasiquote(elt), acc]) } - -private func isMacroCall(_ expr: Expr, env: Env) -> Bool { - if case let .list(ast, _) = expr, - case let .symbol(name) = ast.first, - case let .function(fn) = try? env.get(name) { - return fn.isMacro +private func qq_foldr(_ xs: [Expr]) throws -> Expr { + var acc : Expr = .list([]) + for i in stride(from: xs.count-1, through: 0, by: -1) { + acc = try qq_loop(xs[i], acc:acc) + } + return acc +} +private func quasiquote(_ expr: Expr) throws -> Expr { + switch expr { + case let .list(xs, _): + if 0 < xs.count && xs[0] == .symbol("unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("unquote") } + return xs[1] + } else { + return try qq_foldr(xs) + } + case let .vector(xs, _): + return .list([.symbol("vec"), try qq_foldr(xs)]) + case .symbol(_), .hashmap(_): + return .list([.symbol("quote"), expr]) + default: + return expr } - return false } private func macroExpand(_ expr: Expr, env: Env) throws -> Expr { @@ -137,6 +119,10 @@ func eval(_ expr: Expr, env: Env) throws -> Expr { guard ast.count == 2 else { throw MalError.invalidArguments("quote") } return ast[1] + case .symbol("quasiquoteexpand"): + guard ast.count == 2 else { throw MalError.invalidArguments("quasiquoteexpand") } + return try quasiquote(ast[1]) + case .symbol("quasiquote"): guard ast.count == 2 else { throw MalError.invalidArguments("quasiquote") } expr = try quasiquote(ast[1]) diff --git a/impls/swift5/Sources/step9_try/main.swift b/impls/swift5/Sources/step9_try/main.swift index f80e05ec..91c5a34c 100644 --- a/impls/swift5/Sources/step9_try/main.swift +++ b/impls/swift5/Sources/step9_try/main.swift @@ -5,47 +5,38 @@ func read(_ s: String) throws -> Expr { return try Reader.read(s) } -private func isPair(_ expr: Expr) -> Bool { - switch expr { - case let .list(values, _), let .vector(values, _): - return !values.isEmpty - default: - return false - } -} - -private func asListOrVector(_ expr: Expr) -> [Expr]? { - switch expr { - case let .list(values, _), let .vector(values, _): - return values - default: - return nil - } -} - -private func quasiquote(_ expr: Expr) throws -> Expr { - if !isPair(expr) { - return .list([.symbol("quote"), expr]) - } - guard let ast = asListOrVector(expr), !ast.isEmpty else { - throw MalError.invalidArguments("quasiquote") - } - - if case .symbol("unquote") = ast[0] { - guard ast.count > 1 else { throw MalError.invalidArguments("unquote") } - return ast[1] - } - - if isPair(ast[0]), let ast0 = asListOrVector(ast[0]) { - if case .symbol("splice-unquote") = ast0.first { - guard ast0.count > 1 else { throw MalError.invalidArguments("splice-unquote") } - let rest = try quasiquote(.list(Array(ast[1...]))) - return .list([.symbol("concat"), ast0[1], rest]) +private func qq_loop(_ elt: Expr, acc: Expr) throws -> Expr { + if case let .list(xs, _) = elt { + if 0 < xs.count && xs[0] == .symbol("splice-unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("splice-unquote") } + return .list([.symbol("concat"), xs[1], acc]) } } - - let rest = try quasiquote(.list(Array(ast[1...]))) - return .list([.symbol("cons"), try quasiquote(ast[0]), rest]) + return .list([.symbol("cons"), try quasiquote(elt), acc]) +} +private func qq_foldr(_ xs: [Expr]) throws -> Expr { + var acc : Expr = .list([]) + for i in stride(from: xs.count-1, through: 0, by: -1) { + acc = try qq_loop(xs[i], acc:acc) + } + return acc +} +private func quasiquote(_ expr: Expr) throws -> Expr { + switch expr { + case let .list(xs, _): + if 0 < xs.count && xs[0] == .symbol("unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("unquote") } + return xs[1] + } else { + return try qq_foldr(xs) + } + case let .vector(xs, _): + return .list([.symbol("vec"), try qq_foldr(xs)]) + case .symbol(_), .hashmap(_): + return .list([.symbol("quote"), expr]) + default: + return expr + } } private func macroExpand(_ expr: Expr, env: Env) throws -> Expr { @@ -128,6 +119,10 @@ func eval(_ expr: Expr, env: Env) throws -> Expr { guard ast.count == 2 else { throw MalError.invalidArguments("quote") } return ast[1] + case .symbol("quasiquoteexpand"): + guard ast.count == 2 else { throw MalError.invalidArguments("quasiquoteexpand") } + return try quasiquote(ast[1]) + case .symbol("quasiquote"): guard ast.count == 2 else { throw MalError.invalidArguments("quasiquote") } expr = try quasiquote(ast[1]) diff --git a/impls/swift5/Sources/stepA_mal/main.swift b/impls/swift5/Sources/stepA_mal/main.swift index f6cf6940..1f0aa5b1 100644 --- a/impls/swift5/Sources/stepA_mal/main.swift +++ b/impls/swift5/Sources/stepA_mal/main.swift @@ -5,47 +5,38 @@ func read(_ s: String) throws -> Expr { return try Reader.read(s) } -private func isPair(_ expr: Expr) -> Bool { - switch expr { - case let .list(values, _), let .vector(values, _): - return !values.isEmpty - default: - return false - } -} - -private func asListOrVector(_ expr: Expr) -> [Expr]? { - switch expr { - case let .list(values, _), let .vector(values, _): - return values - default: - return nil - } -} - -private func quasiquote(_ expr: Expr) throws -> Expr { - if !isPair(expr) { - return .list([.symbol("quote"), expr]) - } - guard let ast = asListOrVector(expr), !ast.isEmpty else { - throw MalError.invalidArguments("quasiquote") - } - - if case .symbol("unquote") = ast[0] { - guard ast.count > 1 else { throw MalError.invalidArguments("unquote") } - return ast[1] - } - - if isPair(ast[0]), let ast0 = asListOrVector(ast[0]) { - if case .symbol("splice-unquote") = ast0.first { - guard ast0.count > 1 else { throw MalError.invalidArguments("splice-unquote") } - let rest = try quasiquote(.list(Array(ast[1...]))) - return .list([.symbol("concat"), ast0[1], rest]) +private func qq_loop(_ elt: Expr, acc: Expr) throws -> Expr { + if case let .list(xs, _) = elt { + if 0 < xs.count && xs[0] == .symbol("splice-unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("splice-unquote") } + return .list([.symbol("concat"), xs[1], acc]) } } - - let rest = try quasiquote(.list(Array(ast[1...]))) - return .list([.symbol("cons"), try quasiquote(ast[0]), rest]) + return .list([.symbol("cons"), try quasiquote(elt), acc]) +} +private func qq_foldr(_ xs: [Expr]) throws -> Expr { + var acc : Expr = .list([]) + for i in stride(from: xs.count-1, through: 0, by: -1) { + acc = try qq_loop(xs[i], acc:acc) + } + return acc +} +private func quasiquote(_ expr: Expr) throws -> Expr { + switch expr { + case let .list(xs, _): + if 0 < xs.count && xs[0] == .symbol("unquote") { + guard xs.count == 2 else { throw MalError.invalidArguments("unquote") } + return xs[1] + } else { + return try qq_foldr(xs) + } + case let .vector(xs, _): + return .list([.symbol("vec"), try qq_foldr(xs)]) + case .symbol(_), .hashmap(_): + return .list([.symbol("quote"), expr]) + default: + return expr + } } private func macroExpand(_ expr: Expr, env: Env) throws -> Expr { @@ -128,6 +119,10 @@ func eval(_ expr: Expr, env: Env) throws -> Expr { guard ast.count == 2 else { throw MalError.invalidArguments("quote") } return ast[1] + case .symbol("quasiquoteexpand"): + guard ast.count == 2 else { throw MalError.invalidArguments("quasiquoteexpand") } + return try quasiquote(ast[1]) + case .symbol("quasiquote"): guard ast.count == 2 else { throw MalError.invalidArguments("quasiquote") } expr = try quasiquote(ast[1]) diff --git a/impls/tcl/core.tcl b/impls/tcl/core.tcl index b168afb1..248bb5f8 100644 --- a/impls/tcl/core.tcl +++ b/impls/tcl/core.tcl @@ -236,6 +236,17 @@ proc mal_concat {a} { list_new $res } +proc mal_vec {a} { + lassign $a a0 + if {[vector_q $a0]} { + return $a0 + } elseif {[list_q $a0]} { + return [vector_new [obj_val $a0]] + } else { + error "vec requires list or vector" + } +} + proc mal_nth {a} { lassign $a lst_obj index_obj set index [obj_val $index_obj] @@ -438,6 +449,7 @@ set core_ns [dict create \ "sequential?" [nativefunction_new mal_sequential_q] \ "cons" [nativefunction_new mal_cons] \ "concat" [nativefunction_new mal_concat] \ + "vec" [nativefunction_new mal_vec] \ "nth" [nativefunction_new mal_nth] \ "first" [nativefunction_new mal_first] \ "rest" [nativefunction_new mal_rest] \ diff --git a/impls/tcl/step7_quote.tcl b/impls/tcl/step7_quote.tcl index 6fbfe56d..41d76ea9 100644 --- a/impls/tcl/step7_quote.tcl +++ b/impls/tcl/step7_quote.tcl @@ -9,24 +9,49 @@ proc READ str { read_str $str } -proc is_pair {ast} { - expr {[sequential_q $ast] && [llength [obj_val $ast]] > 0} +proc starts_with {lst sym} { + if {[llength $lst] != 2} { + return 0 + } + lassign [lindex $lst 0] a0 + return [symbol_q $a0] && [expr {[obj_val $a0] == $sym}] +} +proc qq_loop {elt acc} { + if {[list_q $elt] && [starts_with [obj_val $elt] "splice-unquote"]} { + return [list_new [list [symbol_new "concat"] [lindex [obj_val $elt] 1] $acc]] + } else { + return [list_new [list [symbol_new "cons"] [quasiquote $elt] $acc]] + } +} +proc qq_foldr {xs} { + set acc [list_new []] + for {set i [expr {[llength $xs] - 1}]} {0 <= $i} {incr i -1} { + set acc [qq_loop [lindex $xs $i] $acc] + } + return $acc } proc quasiquote {ast} { - if {![is_pair $ast]} { - return [list_new [list [symbol_new "quote"] $ast]] - } - lassign [obj_val $ast] a0 a1 - if {[symbol_q $a0] && [obj_val $a0] == "unquote"} { - return $a1 - } - lassign [obj_val $a0] a00 a01 - set rest [list_new [lrange [obj_val $ast] 1 end]] - if {[is_pair $a0] && [symbol_q $a00] && [obj_val $a00] == "splice-unquote"} { - return [list_new [list [symbol_new "concat"] $a01 [quasiquote $rest]]] - } else { - return [list_new [list [symbol_new "cons"] [quasiquote $a0] [quasiquote $rest]]] + switch [obj_type $ast] { + "symbol" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "hashmap" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "vector" { + return [list_new [list [symbol_new "vec"] [qq_foldr [obj_val $ast]]]] + } + "list" { + if {[starts_with [obj_val $ast] "unquote"]} { + return [lindex [obj_val $ast] 1] + } else { + return [qq_foldr [obj_val $ast]] + } + } + default { + return $ast + } } } @@ -89,6 +114,9 @@ proc EVAL {ast env} { "quote" { return $a1 } + "quasiquoteexpand" { + return [quasiquote $a1] + } "quasiquote" { set ast [quasiquote $a1] } diff --git a/impls/tcl/step8_macros.tcl b/impls/tcl/step8_macros.tcl index a9ecdb9e..9994e2ca 100644 --- a/impls/tcl/step8_macros.tcl +++ b/impls/tcl/step8_macros.tcl @@ -9,24 +9,49 @@ proc READ str { read_str $str } -proc is_pair {ast} { - expr {[sequential_q $ast] && [llength [obj_val $ast]] > 0} +proc starts_with {lst sym} { + if {[llength $lst] != 2} { + return 0 + } + lassign [lindex $lst 0] a0 + return [symbol_q $a0] && [expr {[obj_val $a0] == $sym}] +} +proc qq_loop {elt acc} { + if {[list_q $elt] && [starts_with [obj_val $elt] "splice-unquote"]} { + return [list_new [list [symbol_new "concat"] [lindex [obj_val $elt] 1] $acc]] + } else { + return [list_new [list [symbol_new "cons"] [quasiquote $elt] $acc]] + } +} +proc qq_foldr {xs} { + set acc [list_new []] + for {set i [expr {[llength $xs] - 1}]} {0 <= $i} {incr i -1} { + set acc [qq_loop [lindex $xs $i] $acc] + } + return $acc } proc quasiquote {ast} { - if {![is_pair $ast]} { - return [list_new [list [symbol_new "quote"] $ast]] - } - lassign [obj_val $ast] a0 a1 - if {[symbol_q $a0] && [obj_val $a0] == "unquote"} { - return $a1 - } - lassign [obj_val $a0] a00 a01 - set rest [list_new [lrange [obj_val $ast] 1 end]] - if {[is_pair $a0] && [symbol_q $a00] && [obj_val $a00] == "splice-unquote"} { - return [list_new [list [symbol_new "concat"] $a01 [quasiquote $rest]]] - } else { - return [list_new [list [symbol_new "cons"] [quasiquote $a0] [quasiquote $rest]]] + switch [obj_type $ast] { + "symbol" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "hashmap" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "vector" { + return [list_new [list [symbol_new "vec"] [qq_foldr [obj_val $ast]]]] + } + "list" { + if {[starts_with [obj_val $ast] "unquote"]} { + return [lindex [obj_val $ast] 1] + } else { + return [qq_foldr [obj_val $ast]] + } + } + default { + return $ast + } } } @@ -128,6 +153,9 @@ proc EVAL {ast env} { "quote" { return $a1 } + "quasiquoteexpand" { + return [quasiquote $a1] + } "quasiquote" { set ast [quasiquote $a1] } diff --git a/impls/tcl/step9_try.tcl b/impls/tcl/step9_try.tcl index 3fd8ef26..adabda38 100644 --- a/impls/tcl/step9_try.tcl +++ b/impls/tcl/step9_try.tcl @@ -9,24 +9,49 @@ proc READ str { read_str $str } -proc is_pair {ast} { - expr {[sequential_q $ast] && [llength [obj_val $ast]] > 0} +proc starts_with {lst sym} { + if {[llength $lst] != 2} { + return 0 + } + lassign [lindex $lst 0] a0 + return [symbol_q $a0] && [expr {[obj_val $a0] == $sym}] +} +proc qq_loop {elt acc} { + if {[list_q $elt] && [starts_with [obj_val $elt] "splice-unquote"]} { + return [list_new [list [symbol_new "concat"] [lindex [obj_val $elt] 1] $acc]] + } else { + return [list_new [list [symbol_new "cons"] [quasiquote $elt] $acc]] + } +} +proc qq_foldr {xs} { + set acc [list_new []] + for {set i [expr {[llength $xs] - 1}]} {0 <= $i} {incr i -1} { + set acc [qq_loop [lindex $xs $i] $acc] + } + return $acc } proc quasiquote {ast} { - if {![is_pair $ast]} { - return [list_new [list [symbol_new "quote"] $ast]] - } - lassign [obj_val $ast] a0 a1 - if {[symbol_q $a0] && [obj_val $a0] == "unquote"} { - return $a1 - } - lassign [obj_val $a0] a00 a01 - set rest [list_new [lrange [obj_val $ast] 1 end]] - if {[is_pair $a0] && [symbol_q $a00] && [obj_val $a00] == "splice-unquote"} { - return [list_new [list [symbol_new "concat"] $a01 [quasiquote $rest]]] - } else { - return [list_new [list [symbol_new "cons"] [quasiquote $a0] [quasiquote $rest]]] + switch [obj_type $ast] { + "symbol" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "hashmap" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "vector" { + return [list_new [list [symbol_new "vec"] [qq_foldr [obj_val $ast]]]] + } + "list" { + if {[starts_with [obj_val $ast] "unquote"]} { + return [lindex [obj_val $ast] 1] + } else { + return [qq_foldr [obj_val $ast]] + } + } + default { + return $ast + } } } @@ -128,6 +153,9 @@ proc EVAL {ast env} { "quote" { return $a1 } + "quasiquoteexpand" { + return [quasiquote $a1] + } "quasiquote" { set ast [quasiquote $a1] } diff --git a/impls/tcl/stepA_mal.tcl b/impls/tcl/stepA_mal.tcl index b5bf5a79..48d6c51a 100644 --- a/impls/tcl/stepA_mal.tcl +++ b/impls/tcl/stepA_mal.tcl @@ -9,24 +9,49 @@ proc READ str { read_str $str } -proc is_pair {ast} { - expr {[sequential_q $ast] && [llength [obj_val $ast]] > 0} +proc starts_with {lst sym} { + if {[llength $lst] != 2} { + return 0 + } + lassign [lindex $lst 0] a0 + return [symbol_q $a0] && [expr {[obj_val $a0] == $sym}] +} +proc qq_loop {elt acc} { + if {[list_q $elt] && [starts_with [obj_val $elt] "splice-unquote"]} { + return [list_new [list [symbol_new "concat"] [lindex [obj_val $elt] 1] $acc]] + } else { + return [list_new [list [symbol_new "cons"] [quasiquote $elt] $acc]] + } +} +proc qq_foldr {xs} { + set acc [list_new []] + for {set i [expr {[llength $xs] - 1}]} {0 <= $i} {incr i -1} { + set acc [qq_loop [lindex $xs $i] $acc] + } + return $acc } proc quasiquote {ast} { - if {![is_pair $ast]} { - return [list_new [list [symbol_new "quote"] $ast]] - } - lassign [obj_val $ast] a0 a1 - if {[symbol_q $a0] && [obj_val $a0] == "unquote"} { - return $a1 - } - lassign [obj_val $a0] a00 a01 - set rest [list_new [lrange [obj_val $ast] 1 end]] - if {[is_pair $a0] && [symbol_q $a00] && [obj_val $a00] == "splice-unquote"} { - return [list_new [list [symbol_new "concat"] $a01 [quasiquote $rest]]] - } else { - return [list_new [list [symbol_new "cons"] [quasiquote $a0] [quasiquote $rest]]] + switch [obj_type $ast] { + "symbol" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "hashmap" { + return [list_new [list [symbol_new "quote"] $ast]] + } + "vector" { + return [list_new [list [symbol_new "vec"] [qq_foldr [obj_val $ast]]]] + } + "list" { + if {[starts_with [obj_val $ast] "unquote"]} { + return [lindex [obj_val $ast] 1] + } else { + return [qq_foldr [obj_val $ast]] + } + } + default { + return $ast + } } } @@ -128,6 +153,9 @@ proc EVAL {ast env} { "quote" { return $a1 } + "quasiquoteexpand" { + return [quasiquote $a1] + } "quasiquote" { set ast [quasiquote $a1] } diff --git a/impls/tests/step7_quote.mal b/impls/tests/step7_quote.mal index e2c12248..3b55d077 100644 --- a/impls/tests/step7_quote.mal +++ b/impls/tests/step7_quote.mal @@ -46,14 +46,36 @@ b ;=>(1 2 (3 4)) ;; Testing simple quasiquote +(quasiquote nil) +;=>nil (quasiquote 7) ;=>7 +(quasiquote a) +;=>a +(quasiquote {"a" b}) +;=>{"a" b} + +;; Testing quasiquote with lists +(quasiquote ()) +;=>() (quasiquote (1 2 3)) ;=>(1 2 3) +(quasiquote (a)) +;=>(a) (quasiquote (1 2 (3 4))) ;=>(1 2 (3 4)) (quasiquote (nil)) ;=>(nil) +(quasiquote (1 ())) +;=>(1 ()) +(quasiquote (() 1)) +;=>(() 1) +(quasiquote (1 () 2)) +;=>(1 () 2) +(quasiquote (())) +;=>(()) +;; (quasiquote (f () g (h) i (j k) l)) +;; =>(f () g (h) i (j k) l) ;; Testing unquote (quasiquote (unquote 7)) @@ -77,6 +99,10 @@ b (quasiquote ((unquote 1) (unquote 2))) ;=>(1 2) +;; Quasiquote and environments +(let* (x 0) (quasiquote (unquote x))) +;=>0 + ;; Testing splice-unquote (def! c (quote (1 "b" "d"))) ;=>(1 "b" "d") @@ -84,7 +110,12 @@ b ;=>(1 c 3) (quasiquote (1 (splice-unquote c) 3)) ;=>(1 1 "b" "d" 3) - +(quasiquote (1 (splice-unquote c))) +;=>(1 1 "b" "d") +(quasiquote ((splice-unquote c) 2)) +;=>(1 "b" "d" 2) +(quasiquote ((splice-unquote c) (splice-unquote c))) +;=>(1 "b" "d" 1 "b" "d") ;; Testing symbol equality (= (quote abc) (quote abc)) @@ -102,11 +133,6 @@ b (= nil (quote abc)) ;=>false -;;;;; Test quine -;;; TODO: needs expect line length fix -;;;((fn* [q] (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* [q] (quasiquote ((unquote q) (quote (unquote q))))))) -;;;=>((fn* [q] (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* [q] (quasiquote ((unquote q) (quote (unquote q))))))) - ;>>> deferrable=True ;; ;; -------- Deferrable Functionality -------- @@ -121,6 +147,8 @@ b ;; Testing cons and concat with vectors +(cons 1 []) +;=>(1) (cons [1] [2 3]) ;=>([1] 2 3) (cons 1 [2 3]) @@ -130,7 +158,6 @@ b (concat [1 2]) ;=>(1 2) - ;>>> optional=True ;; ;; -------- Optional Functionality -------- @@ -167,18 +194,154 @@ b `(1 ~@c 3) ;=>(1 1 "b" "d" 3) -;; Testing unquote with vectors +;>>> soft=True + +;; Testing vec function + +(vec (list)) +;=>[] +(vec (list 1)) +;=>[1] +(vec (list 1 2)) +;=>[1 2] +(vec []) +;=>[] +(vec [1 2]) +;=>[1 2] + +;; Testing that vec does not mutate the original list +(def! a (list 1 2)) +(vec a) +;=>[1 2] +a +;=>(1 2) + +;; Test quine +((fn* (q) (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* (q) (quasiquote ((unquote q) (quote (unquote q))))))) +;=>((fn* (q) (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* (q) (quasiquote ((unquote q) (quote (unquote q))))))) + +;; Testing quasiquote with vectors +(quasiquote []) +;=>[] +(quasiquote [[]]) +;=>[[]] +(quasiquote [()]) +;=>[()] +(quasiquote ([])) +;=>([]) (def! a 8) ;=>8 `[1 a 3] -;=>(1 a 3) -;;; TODO: fix this -;;;;=>[1 a 3] +;=>[1 a 3] +(quasiquote [a [] b [c] d [e f] g]) +;=>[a [] b [c] d [e f] g] + +;; Testing unquote with vectors +`[~a] +;=>[8] +`[(~a)] +;=>[(8)] +`([~a]) +;=>([8]) +`[a ~a a] +;=>[a 8 a] +`([a ~a a]) +;=>([a 8 a]) +`[(a ~a a)] +;=>[(a 8 a)] ;; Testing splice-unquote with vectors (def! c '(1 "b" "d")) ;=>(1 "b" "d") +`[~@c] +;=>[1 "b" "d"] +`[(~@c)] +;=>[(1 "b" "d")] +`([~@c]) +;=>([1 "b" "d"]) `[1 ~@c 3] -;=>(1 1 "b" "d" 3) -;;; TODO: fix this -;;;;=>[1 1 "b" "d" 3] +;=>[1 1 "b" "d" 3] +`([1 ~@c 3]) +;=>([1 1 "b" "d" 3]) +`[(1 ~@c 3)] +;=>[(1 1 "b" "d" 3)] + +;; Misplaced unquote or splice-unquote +`(0 unquote) +;=>(0 unquote) +`(0 splice-unquote) +;=>(0 splice-unquote) +`[unquote 0] +;=>[unquote 0] +`[splice-unquote 0] +;=>[splice-unquote 0] + +;; Debugging quasiquote +(quasiquoteexpand nil) +;=>nil +(quasiquoteexpand 7) +;=>7 +(quasiquoteexpand a) +;=>(quote a) +(quasiquoteexpand {"a" b}) +;=>(quote {"a" b}) +(quasiquoteexpand ()) +;=>() +(quasiquoteexpand (1 2 3)) +;=>(cons 1 (cons 2 (cons 3 ()))) +(quasiquoteexpand (a)) +;=>(cons (quote a) ()) +(quasiquoteexpand (1 2 (3 4))) +;=>(cons 1 (cons 2 (cons (cons 3 (cons 4 ())) ()))) +(quasiquoteexpand (nil)) +;=>(cons nil ()) +(quasiquoteexpand (1 ())) +;=>(cons 1 (cons () ())) +(quasiquoteexpand (() 1)) +;=>(cons () (cons 1 ())) +(quasiquoteexpand (1 () 2)) +;=>(cons 1 (cons () (cons 2 ()))) +(quasiquoteexpand (())) +;=>(cons () ()) +(quasiquoteexpand (f () g (h) i (j k) l)) +;=>(cons (quote f) (cons () (cons (quote g) (cons (cons (quote h) ()) (cons (quote i) (cons (cons (quote j) (cons (quote k) ())) (cons (quote l) ()))))))) +(quasiquoteexpand (unquote 7)) +;=>7 +(quasiquoteexpand a) +;=>(quote a) +(quasiquoteexpand (unquote a)) +;=>a +(quasiquoteexpand (1 a 3)) +;=>(cons 1 (cons (quote a) (cons 3 ()))) +(quasiquoteexpand (1 (unquote a) 3)) +;=>(cons 1 (cons a (cons 3 ()))) +(quasiquoteexpand (1 b 3)) +;=>(cons 1 (cons (quote b) (cons 3 ()))) +(quasiquoteexpand (1 (unquote b) 3)) +;=>(cons 1 (cons b (cons 3 ()))) +(quasiquoteexpand ((unquote 1) (unquote 2))) +;=>(cons 1 (cons 2 ())) +(quasiquoteexpand (a (splice-unquote (b c)) d)) +;=>(cons (quote a) (concat (b c) (cons (quote d) ()))) +(quasiquoteexpand (1 c 3)) +;=>(cons 1 (cons (quote c) (cons 3 ()))) +(quasiquoteexpand (1 (splice-unquote c) 3)) +;=>(cons 1 (concat c (cons 3 ()))) +(quasiquoteexpand (1 (splice-unquote c))) +;=>(cons 1 (concat c ())) +(quasiquoteexpand ((splice-unquote c) 2)) +;=>(concat c (cons 2 ())) +(quasiquoteexpand ((splice-unquote c) (splice-unquote c))) +;=>(concat c (concat c ())) +(quasiquoteexpand []) +;=>(vec ()) +(quasiquoteexpand [[]]) +;=>(vec (cons (vec ()) ())) +(quasiquoteexpand [()]) +;=>(vec (cons () ())) +(quasiquoteexpand ([])) +;=>(cons (vec ()) ()) +(quasiquoteexpand [1 a 3]) +;=>(vec (cons 1 (cons (quote a) (cons 3 ())))) +(quasiquoteexpand [a [] b [c] d [e f] g]) +;=>(vec (cons (quote a) (cons (vec ()) (cons (quote b) (cons (vec (cons (quote c) ())) (cons (quote d) (cons (vec (cons (quote e) (cons (quote f) ()))) (cons (quote g) ())))))))) diff --git a/impls/tests/step8_macros.mal b/impls/tests/step8_macros.mal index bbc35c1c..6fd1ef9d 100644 --- a/impls/tests/step8_macros.mal +++ b/impls/tests/step8_macros.mal @@ -19,11 +19,19 @@ ;=>8 ;; Testing macroexpand +(macroexpand (one)) +;=>1 +(macroexpand (unless PRED A B)) +;=>(if PRED B A) +(macroexpand (unless2 PRED A B)) +;=>(if (not PRED) A B) (macroexpand (unless2 2 3 4)) ;=>(if (not 2) 3 4) ;; Testing evaluation of macro result (defmacro! identity (fn* (x) x)) +(let* (a 123) (macroexpand (identity a))) +;=>a (let* (a 123) (identity a)) ;=>123 @@ -31,6 +39,9 @@ () ;=>() +;; Test that macros do not break quasiquote +`(1) +;=>(1) ;>>> deferrable=True ;; @@ -73,10 +84,18 @@ x ;; Testing cond macro +(macroexpand (cond)) +;=>nil (cond) ;=>nil +(macroexpand (cond X Y)) +;=>(if X Y (cond)) (cond true 7) ;=>7 +(cond false 7) +;=>nil +(macroexpand (cond X Y Z T)) +;=>(if X Y (cond Z T)) (cond true 7 true 8) ;=>7 (cond false 7 true 8) diff --git a/impls/ts/core.ts b/impls/ts/core.ts index ddf5fcb6..dbf94238 100644 --- a/impls/ts/core.ts +++ b/impls/ts/core.ts @@ -274,6 +274,16 @@ export const ns: Map = (() => { return new MalList(list); }, + vec(a: MalType) { + switch (a.type) { + case Node.List: + return new MalVector(a.list); + case Node.Vector: + return a; + } + throw new Error(`unexpected symbol: ${a.type}, expected: list or vector`); + }, + nth(list: MalType, idx: MalType) { if (!isSeq(list)) { throw new Error(`unexpected symbol: ${list.type}, expected: list or vector`); diff --git a/impls/ts/step7_quote.ts b/impls/ts/step7_quote.ts index 14867924..2b1d47f8 100644 --- a/impls/ts/step7_quote.ts +++ b/impls/ts/step7_quote.ts @@ -11,43 +11,49 @@ function read(str: string): MalType { return readStr(str); } +function starts_with(lst: MalType[], sym: string): boolean { + if (lst.length == 2) { + let a0 = lst[0] + switch (a0.type) { + case Node.Symbol: + return a0.v === sym; + } + } + return false; +} + +function qq_loop(elt: MalType, acc: MalList): MalList { + if (elt.type == Node.List && starts_with(elt.list, "splice-unquote")) { + return new MalList([MalSymbol.get("concat"), elt.list[1], acc]); + } else { + return new MalList([MalSymbol.get("cons"), quasiquote(elt), acc]); + } +} + +function qq_foldr(xs : MalType[]): MalList { + let acc = new MalList([]) + for (let i=xs.length-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc; +} + function quasiquote(ast: MalType): MalType { - if (!isPair(ast)) { - return new MalList([MalSymbol.get("quote"), ast]); - } - if (!isSeq(ast)) { - throw new Error(`unexpected token type: ${ast.type}, expected: list or vector`); - } - const [arg1, arg2] = ast.list; - if (arg1.type === Node.Symbol && arg1.v === "unquote") { - return arg2; - } - if (isPair(arg1)) { - if (!isSeq(arg1)) { - throw new Error(`unexpected token type: ${arg1.type}, expected: list or vector`); - } - const [arg11, arg12] = arg1.list; - if (arg11.type === Node.Symbol && arg11.v === "splice-unquote") { - return new MalList([ - MalSymbol.get("concat"), - arg12, - quasiquote(new MalList(ast.list.slice(1))), - ]); - } - } - - return new MalList([ - MalSymbol.get("cons"), - quasiquote(arg1), - quasiquote(new MalList(ast.list.slice(1))), - ]); - - function isPair(ast: MalType) { - if (!isSeq(ast)) { - return false; - } - - return 0 < ast.list.length; + switch (ast.type) { + case Node.Symbol: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.HashMap: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.List: + if (starts_with(ast.list, "unquote")) { + return ast.list[1]; + } else { + return qq_foldr(ast.list); + } + case Node.Vector: + return new MalList([MalSymbol.get("vec"), qq_foldr(ast.list)]); + default: + return ast; } } @@ -122,6 +128,9 @@ function evalMal(ast: MalType, env: Env): MalType { case "quote": { return ast.list[1]; } + case "quasiquoteexpand": { + return quasiquote(ast.list[1]); + } case "quasiquote": { ast = quasiquote(ast.list[1]); continue loop; diff --git a/impls/ts/step8_macros.ts b/impls/ts/step8_macros.ts index 537c4194..e319ca5f 100644 --- a/impls/ts/step8_macros.ts +++ b/impls/ts/step8_macros.ts @@ -11,43 +11,49 @@ function read(str: string): MalType { return readStr(str); } +function starts_with(lst: MalType[], sym: string): boolean { + if (lst.length == 2) { + let a0 = lst[0] + switch (a0.type) { + case Node.Symbol: + return a0.v === sym; + } + } + return false; +} + +function qq_loop(elt: MalType, acc: MalList): MalList { + if (elt.type == Node.List && starts_with(elt.list, "splice-unquote")) { + return new MalList([MalSymbol.get("concat"), elt.list[1], acc]); + } else { + return new MalList([MalSymbol.get("cons"), quasiquote(elt), acc]); + } +} + +function qq_foldr(xs : MalType[]): MalList { + let acc = new MalList([]) + for (let i=xs.length-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc; +} + function quasiquote(ast: MalType): MalType { - if (!isPair(ast)) { - return new MalList([MalSymbol.get("quote"), ast]); - } - if (!isSeq(ast)) { - throw new Error(`unexpected token type: ${ast.type}, expected: list or vector`); - } - const [arg1, arg2] = ast.list; - if (arg1.type === Node.Symbol && arg1.v === "unquote") { - return arg2; - } - if (isPair(arg1)) { - if (!isSeq(arg1)) { - throw new Error(`unexpected token type: ${arg1.type}, expected: list or vector`); - } - const [arg11, arg12] = arg1.list; - if (arg11.type === Node.Symbol && arg11.v === "splice-unquote") { - return new MalList([ - MalSymbol.get("concat"), - arg12, - quasiquote(new MalList(ast.list.slice(1))), - ]); - } - } - - return new MalList([ - MalSymbol.get("cons"), - quasiquote(arg1), - quasiquote(new MalList(ast.list.slice(1))), - ]); - - function isPair(ast: MalType) { - if (!isSeq(ast)) { - return false; - } - - return 0 < ast.list.length; + switch (ast.type) { + case Node.Symbol: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.HashMap: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.List: + if (starts_with(ast.list, "unquote")) { + return ast.list[1]; + } else { + return qq_foldr(ast.list); + } + case Node.Vector: + return new MalList([MalSymbol.get("vec"), qq_foldr(ast.list)]); + default: + return ast; } } @@ -171,6 +177,9 @@ function evalMal(ast: MalType, env: Env): MalType { case "quote": { return ast.list[1]; } + case "quasiquoteexpand": { + return quasiquote(ast.list[1]); + } case "quasiquote": { ast = quasiquote(ast.list[1]); continue loop; diff --git a/impls/ts/step9_try.ts b/impls/ts/step9_try.ts index d07f304c..8b50db72 100644 --- a/impls/ts/step9_try.ts +++ b/impls/ts/step9_try.ts @@ -11,43 +11,49 @@ function read(str: string): MalType { return readStr(str); } +function starts_with(lst: MalType[], sym: string): boolean { + if (lst.length == 2) { + let a0 = lst[0] + switch (a0.type) { + case Node.Symbol: + return a0.v === sym; + } + } + return false; +} + +function qq_loop(elt: MalType, acc: MalList): MalList { + if (elt.type == Node.List && starts_with(elt.list, "splice-unquote")) { + return new MalList([MalSymbol.get("concat"), elt.list[1], acc]); + } else { + return new MalList([MalSymbol.get("cons"), quasiquote(elt), acc]); + } +} + +function qq_foldr(xs : MalType[]): MalList { + let acc = new MalList([]) + for (let i=xs.length-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc; +} + function quasiquote(ast: MalType): MalType { - if (!isPair(ast)) { - return new MalList([MalSymbol.get("quote"), ast]); - } - if (!isSeq(ast)) { - throw new Error(`unexpected token type: ${ast.type}, expected: list or vector`); - } - const [arg1, arg2] = ast.list; - if (arg1.type === Node.Symbol && arg1.v === "unquote") { - return arg2; - } - if (isPair(arg1)) { - if (!isSeq(arg1)) { - throw new Error(`unexpected token type: ${arg1.type}, expected: list or vector`); - } - const [arg11, arg12] = arg1.list; - if (arg11.type === Node.Symbol && arg11.v === "splice-unquote") { - return new MalList([ - MalSymbol.get("concat"), - arg12, - quasiquote(new MalList(ast.list.slice(1))), - ]); - } - } - - return new MalList([ - MalSymbol.get("cons"), - quasiquote(arg1), - quasiquote(new MalList(ast.list.slice(1))), - ]); - - function isPair(ast: MalType) { - if (!isSeq(ast)) { - return false; - } - - return 0 < ast.list.length; + switch (ast.type) { + case Node.Symbol: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.HashMap: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.List: + if (starts_with(ast.list, "unquote")) { + return ast.list[1]; + } else { + return qq_foldr(ast.list); + } + case Node.Vector: + return new MalList([MalSymbol.get("vec"), qq_foldr(ast.list)]); + default: + return ast; } } @@ -171,6 +177,9 @@ function evalMal(ast: MalType, env: Env): MalType { case "quote": { return ast.list[1]; } + case "quasiquoteexpand": { + return quasiquote(ast.list[1]); + } case "quasiquote": { ast = quasiquote(ast.list[1]); continue loop; diff --git a/impls/ts/stepA_mal.ts b/impls/ts/stepA_mal.ts index 6f0a042c..4372f26a 100644 --- a/impls/ts/stepA_mal.ts +++ b/impls/ts/stepA_mal.ts @@ -11,43 +11,49 @@ function read(str: string): MalType { return readStr(str); } +function starts_with(lst: MalType[], sym: string): boolean { + if (lst.length == 2) { + let a0 = lst[0] + switch (a0.type) { + case Node.Symbol: + return a0.v === sym; + } + } + return false; +} + +function qq_loop(elt: MalType, acc: MalList): MalList { + if (elt.type == Node.List && starts_with(elt.list, "splice-unquote")) { + return new MalList([MalSymbol.get("concat"), elt.list[1], acc]); + } else { + return new MalList([MalSymbol.get("cons"), quasiquote(elt), acc]); + } +} + +function qq_foldr(xs : MalType[]): MalList { + let acc = new MalList([]) + for (let i=xs.length-1; 0<=i; i-=1) { + acc = qq_loop(xs[i], acc) + } + return acc; +} + function quasiquote(ast: MalType): MalType { - if (!isPair(ast)) { - return new MalList([MalSymbol.get("quote"), ast]); - } - if (!isSeq(ast)) { - throw new Error(`unexpected token type: ${ast.type}, expected: list or vector`); - } - const [arg1, arg2] = ast.list; - if (arg1.type === Node.Symbol && arg1.v === "unquote") { - return arg2; - } - if (isPair(arg1)) { - if (!isSeq(arg1)) { - throw new Error(`unexpected token type: ${arg1.type}, expected: list or vector`); - } - const [arg11, arg12] = arg1.list; - if (arg11.type === Node.Symbol && arg11.v === "splice-unquote") { - return new MalList([ - MalSymbol.get("concat"), - arg12, - quasiquote(new MalList(ast.list.slice(1))), - ]); - } - } - - return new MalList([ - MalSymbol.get("cons"), - quasiquote(arg1), - quasiquote(new MalList(ast.list.slice(1))), - ]); - - function isPair(ast: MalType) { - if (!isSeq(ast)) { - return false; - } - - return 0 < ast.list.length; + switch (ast.type) { + case Node.Symbol: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.HashMap: + return new MalList([MalSymbol.get("quote"), ast]); + case Node.List: + if (starts_with(ast.list, "unquote")) { + return ast.list[1]; + } else { + return qq_foldr(ast.list); + } + case Node.Vector: + return new MalList([MalSymbol.get("vec"), qq_foldr(ast.list)]); + default: + return ast; } } @@ -171,6 +177,9 @@ function evalMal(ast: MalType, env: Env): MalType { case "quote": { return ast.list[1]; } + case "quasiquoteexpand": { + return quasiquote(ast.list[1]); + } case "quasiquote": { ast = quasiquote(ast.list[1]); continue loop; diff --git a/impls/vala/core.vala b/impls/vala/core.vala index 50a68ce9..bed6c33c 100644 --- a/impls/vala/core.vala +++ b/impls/vala/core.vala @@ -628,6 +628,24 @@ class Mal.BuiltinFunctionConcat : Mal.BuiltinFunction { } } +class Mal.BuiltinFunctionVec : Mal.BuiltinFunction { + public override Mal.ValWithMetadata copy() { + return new Mal.BuiltinFunctionVec(); + } + public override string name() { return "vec"; } + public override Mal.Val call(Mal.List args) throws Mal.Error { + if (args.vs.length() != 1) + throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name()); + var a0 = args.vs.data; + if (a0 is Mal.List) + return new Mal.Vector.from_list((a0 as Mal.List).vs); + if (a0 is Mal.Vector) + return a0; + throw new Mal.Error.BAD_PARAMS( + "%s: expected a list or a vector", name()); + } +} + class Mal.BuiltinFunctionNth : Mal.BuiltinFunction { public override Mal.ValWithMetadata copy() { return new Mal.BuiltinFunctionNth(); @@ -1162,6 +1180,7 @@ class Mal.Core { add_builtin(new BuiltinFunctionSwap()); add_builtin(new BuiltinFunctionCons()); add_builtin(new BuiltinFunctionConcat()); + add_builtin(new BuiltinFunctionVec()); add_builtin(new BuiltinFunctionNth()); add_builtin(new BuiltinFunctionFirst()); add_builtin(new BuiltinFunctionRest()); diff --git a/impls/vala/step7_quote.vala b/impls/vala/step7_quote.vala index 10fb43cd..2347b9b1 100644 --- a/impls/vala/step7_quote.vala +++ b/impls/vala/step7_quote.vala @@ -84,51 +84,68 @@ class Mal.Main : GLib.Object { return val; } + // If ast is (sym x), return x, else return null. + public static Mal.Val? unquoted (Mal.Val ast, + string sym) + throws Mal.Error { + var list = ast as Mal.List; + if (list == null || list.vs == null) return null; + var a0 = list.vs.data as Mal.Sym; + if (a0 == null || a0.v != sym) return null; + if (list.vs.next == null || list.vs.next.next != null) + throw new Mal.Error.BAD_PARAMS(sym + ": wrong arg count"); + return list.vs.next.data; + } + + public static Mal.Val qq_loop(Mal.Val elt, + Mal.Val acc) + throws Mal.Error { + var list = new Mal.List.empty(); + var unq = unquoted(elt, "splice-unquote"); + if (unq != null) { + list.vs.append(new Mal.Sym("concat")); + list.vs.append(unq); + } else { + list.vs.append(new Mal.Sym("cons")); + list.vs.append(quasiquote (elt)); + } + list.vs.append(acc); + return list; + } + + public static Mal.Val qq_foldr(Mal.Iterator xs) + throws Mal.Error { + if (xs.empty()) { + return new Mal.List.empty(); + } else { + var elt = xs.deref(); + xs.step(); + return qq_loop(elt, qq_foldr(xs)); + } + } + public static Mal.Val quasiquote(Mal.Val ast) throws Mal.Error { - if (!is_pair(ast)) { - var list = new GLib.List(); - list.append(new Mal.Sym("quote")); - list.append(ast); - return new Mal.List(list); - } - - var iter = (ast as Mal.Listlike).iter(); - var first = iter.deref(); - if (first is Mal.Sym && (first as Mal.Sym).v == "unquote") { - if (iter.step().empty()) - throw new Mal.Error.BAD_PARAMS( - "unquote: expected two values"); - return iter.deref(); - } - - if (is_pair(first)) { - var fiter = (first as Mal.Listlike).iter(); - var ffirst = fiter.deref(); - if (ffirst is Mal.Sym && - (ffirst as Mal.Sym).v == "splice-unquote") { - var list = new GLib.List(); - list.append(new Mal.Sym("concat")); - if (fiter.step().empty()) - throw new Mal.Error.BAD_PARAMS( - "unquote: expected two values"); - list.append(fiter.deref()); - var sublist = new GLib.List(); - while (!iter.step().empty()) - sublist.append(iter.deref()); - list.append(quasiquote(new Mal.List(sublist))); - return new Mal.List(list); + if (ast is Mal.List) { + var unq = unquoted(ast, "unquote"); + if (unq != null) { + return unq; + } else { + return qq_foldr((ast as Mal.List).iter()); } + } else if (ast is Mal.Vector) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("vec")); + list.vs.append(qq_foldr((ast as Mal.Vector).iter())); + return list; + } else if (ast is Mal.Sym || ast is Mal.Hashmap) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("quote")); + list.vs.append(ast); + return list; + } else { + return ast; } - - var list = new GLib.List(); - list.append(new Mal.Sym("cons")); - list.append(quasiquote(first)); - var sublist = new GLib.List(); - while (!iter.step().empty()) - sublist.append(iter.deref()); - list.append(quasiquote(new Mal.List(sublist))); - return new Mal.List(list); } public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_) @@ -236,6 +253,11 @@ class Mal.Main : GLib.Object { throw new Mal.Error.BAD_PARAMS( "quote: expected one argument"); return list.next.data; + case "quasiquoteexpand": + if (list.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "quasiquoteexpand: expected one argument"); + return quasiquote(list.next.data); case "quasiquote": if (list.length() != 2) throw new Mal.Error.BAD_PARAMS( diff --git a/impls/vala/step8_macros.vala b/impls/vala/step8_macros.vala index ef638719..37aade0b 100644 --- a/impls/vala/step8_macros.vala +++ b/impls/vala/step8_macros.vala @@ -87,51 +87,68 @@ class Mal.Main : GLib.Object { return val; } + // If ast is (sym x), return x, else return null. + public static Mal.Val? unquoted (Mal.Val ast, + string sym) + throws Mal.Error { + var list = ast as Mal.List; + if (list == null || list.vs == null) return null; + var a0 = list.vs.data as Mal.Sym; + if (a0 == null || a0.v != sym) return null; + if (list.vs.next == null || list.vs.next.next != null) + throw new Mal.Error.BAD_PARAMS(sym + ": wrong arg count"); + return list.vs.next.data; + } + + public static Mal.Val qq_loop(Mal.Val elt, + Mal.Val acc) + throws Mal.Error { + var list = new Mal.List.empty(); + var unq = unquoted(elt, "splice-unquote"); + if (unq != null) { + list.vs.append(new Mal.Sym("concat")); + list.vs.append(unq); + } else { + list.vs.append(new Mal.Sym("cons")); + list.vs.append(quasiquote (elt)); + } + list.vs.append(acc); + return list; + } + + public static Mal.Val qq_foldr(Mal.Iterator xs) + throws Mal.Error { + if (xs.empty()) { + return new Mal.List.empty(); + } else { + var elt = xs.deref(); + xs.step(); + return qq_loop(elt, qq_foldr(xs)); + } + } + public static Mal.Val quasiquote(Mal.Val ast) throws Mal.Error { - if (!is_pair(ast)) { - var list = new GLib.List(); - list.append(new Mal.Sym("quote")); - list.append(ast); - return new Mal.List(list); - } - - var iter = (ast as Mal.Listlike).iter(); - var first = iter.deref(); - if (first is Mal.Sym && (first as Mal.Sym).v == "unquote") { - if (iter.step().empty()) - throw new Mal.Error.BAD_PARAMS( - "unquote: expected two values"); - return iter.deref(); - } - - if (is_pair(first)) { - var fiter = (first as Mal.Listlike).iter(); - var ffirst = fiter.deref(); - if (ffirst is Mal.Sym && - (ffirst as Mal.Sym).v == "splice-unquote") { - var list = new GLib.List(); - list.append(new Mal.Sym("concat")); - if (fiter.step().empty()) - throw new Mal.Error.BAD_PARAMS( - "unquote: expected two values"); - list.append(fiter.deref()); - var sublist = new GLib.List(); - while (!iter.step().empty()) - sublist.append(iter.deref()); - list.append(quasiquote(new Mal.List(sublist))); - return new Mal.List(list); + if (ast is Mal.List) { + var unq = unquoted(ast, "unquote"); + if (unq != null) { + return unq; + } else { + return qq_foldr((ast as Mal.List).iter()); } + } else if (ast is Mal.Vector) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("vec")); + list.vs.append(qq_foldr((ast as Mal.Vector).iter())); + return list; + } else if (ast is Mal.Sym || ast is Mal.Hashmap) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("quote")); + list.vs.append(ast); + return list; + } else { + return ast; } - - var list = new GLib.List(); - list.append(new Mal.Sym("cons")); - list.append(quasiquote(first)); - var sublist = new GLib.List(); - while (!iter.step().empty()) - sublist.append(iter.deref()); - list.append(quasiquote(new Mal.List(sublist))); - return new Mal.List(list); } public static bool is_macro_call(Mal.Val v, Mal.Env env) { @@ -269,6 +286,11 @@ class Mal.Main : GLib.Object { throw new Mal.Error.BAD_PARAMS( "quote: expected one argument"); return list.next.data; + case "quasiquoteexpand": + if (list.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "quasiquoteexpand: expected one argument"); + return quasiquote(list.next.data); case "quasiquote": if (list.length() != 2) throw new Mal.Error.BAD_PARAMS( diff --git a/impls/vala/step9_try.vala b/impls/vala/step9_try.vala index 9cd3d60f..97b09a11 100644 --- a/impls/vala/step9_try.vala +++ b/impls/vala/step9_try.vala @@ -88,51 +88,68 @@ class Mal.Main : GLib.Object { return val; } + // If ast is (sym x), return x, else return null. + public static Mal.Val? unquoted (Mal.Val ast, + string sym) + throws Mal.Error { + var list = ast as Mal.List; + if (list == null || list.vs == null) return null; + var a0 = list.vs.data as Mal.Sym; + if (a0 == null || a0.v != sym) return null; + if (list.vs.next == null || list.vs.next.next != null) + throw new Mal.Error.BAD_PARAMS(sym + ": wrong arg count"); + return list.vs.next.data; + } + + public static Mal.Val qq_loop(Mal.Val elt, + Mal.Val acc) + throws Mal.Error { + var list = new Mal.List.empty(); + var unq = unquoted(elt, "splice-unquote"); + if (unq != null) { + list.vs.append(new Mal.Sym("concat")); + list.vs.append(unq); + } else { + list.vs.append(new Mal.Sym("cons")); + list.vs.append(quasiquote (elt)); + } + list.vs.append(acc); + return list; + } + + public static Mal.Val qq_foldr(Mal.Iterator xs) + throws Mal.Error { + if (xs.empty()) { + return new Mal.List.empty(); + } else { + var elt = xs.deref(); + xs.step(); + return qq_loop(elt, qq_foldr(xs)); + } + } + public static Mal.Val quasiquote(Mal.Val ast) throws Mal.Error { - if (!is_pair(ast)) { - var list = new GLib.List(); - list.append(new Mal.Sym("quote")); - list.append(ast); - return new Mal.List(list); - } - - var iter = (ast as Mal.Listlike).iter(); - var first = iter.deref(); - if (first is Mal.Sym && (first as Mal.Sym).v == "unquote") { - if (iter.step().empty()) - throw new Mal.Error.BAD_PARAMS( - "unquote: expected two values"); - return iter.deref(); - } - - if (is_pair(first)) { - var fiter = (first as Mal.Listlike).iter(); - var ffirst = fiter.deref(); - if (ffirst is Mal.Sym && - (ffirst as Mal.Sym).v == "splice-unquote") { - var list = new GLib.List(); - list.append(new Mal.Sym("concat")); - if (fiter.step().empty()) - throw new Mal.Error.BAD_PARAMS( - "unquote: expected two values"); - list.append(fiter.deref()); - var sublist = new GLib.List(); - while (!iter.step().empty()) - sublist.append(iter.deref()); - list.append(quasiquote(new Mal.List(sublist))); - return new Mal.List(list); + if (ast is Mal.List) { + var unq = unquoted(ast, "unquote"); + if (unq != null) { + return unq; + } else { + return qq_foldr((ast as Mal.List).iter()); } + } else if (ast is Mal.Vector) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("vec")); + list.vs.append(qq_foldr((ast as Mal.Vector).iter())); + return list; + } else if (ast is Mal.Sym || ast is Mal.Hashmap) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("quote")); + list.vs.append(ast); + return list; + } else { + return ast; } - - var list = new GLib.List(); - list.append(new Mal.Sym("cons")); - list.append(quasiquote(first)); - var sublist = new GLib.List(); - while (!iter.step().empty()) - sublist.append(iter.deref()); - list.append(quasiquote(new Mal.List(sublist))); - return new Mal.List(list); } public static bool is_macro_call(Mal.Val v, Mal.Env env) @@ -272,6 +289,11 @@ class Mal.Main : GLib.Object { throw new Mal.Error.BAD_PARAMS( "quote: expected one argument"); return list.next.data; + case "quasiquoteexpand": + if (list.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "quasiquoteexpand: expected one argument"); + return quasiquote(list.next.data); case "quasiquote": if (list.length() != 2) throw new Mal.Error.BAD_PARAMS( diff --git a/impls/vala/stepA_mal.vala b/impls/vala/stepA_mal.vala index df75f81f..c5f1abab 100644 --- a/impls/vala/stepA_mal.vala +++ b/impls/vala/stepA_mal.vala @@ -88,51 +88,68 @@ class Mal.Main : GLib.Object { return val; } + // If ast is (sym x), return x, else return null. + public static Mal.Val? unquoted (Mal.Val ast, + string sym) + throws Mal.Error { + var list = ast as Mal.List; + if (list == null || list.vs == null) return null; + var a0 = list.vs.data as Mal.Sym; + if (a0 == null || a0.v != sym) return null; + if (list.vs.next == null || list.vs.next.next != null) + throw new Mal.Error.BAD_PARAMS(sym + ": wrong arg count"); + return list.vs.next.data; + } + + public static Mal.Val qq_loop(Mal.Val elt, + Mal.Val acc) + throws Mal.Error { + var list = new Mal.List.empty(); + var unq = unquoted(elt, "splice-unquote"); + if (unq != null) { + list.vs.append(new Mal.Sym("concat")); + list.vs.append(unq); + } else { + list.vs.append(new Mal.Sym("cons")); + list.vs.append(quasiquote (elt)); + } + list.vs.append(acc); + return list; + } + + public static Mal.Val qq_foldr(Mal.Iterator xs) + throws Mal.Error { + if (xs.empty()) { + return new Mal.List.empty(); + } else { + var elt = xs.deref(); + xs.step(); + return qq_loop(elt, qq_foldr(xs)); + } + } + public static Mal.Val quasiquote(Mal.Val ast) throws Mal.Error { - if (!is_pair(ast)) { - var list = new GLib.List(); - list.append(new Mal.Sym("quote")); - list.append(ast); - return new Mal.List(list); - } - - var iter = (ast as Mal.Listlike).iter(); - var first = iter.deref(); - if (first is Mal.Sym && (first as Mal.Sym).v == "unquote") { - if (iter.step().empty()) - throw new Mal.Error.BAD_PARAMS( - "unquote: expected two values"); - return iter.deref(); - } - - if (is_pair(first)) { - var fiter = (first as Mal.Listlike).iter(); - var ffirst = fiter.deref(); - if (ffirst is Mal.Sym && - (ffirst as Mal.Sym).v == "splice-unquote") { - var list = new GLib.List(); - list.append(new Mal.Sym("concat")); - if (fiter.step().empty()) - throw new Mal.Error.BAD_PARAMS( - "unquote: expected two values"); - list.append(fiter.deref()); - var sublist = new GLib.List(); - while (!iter.step().empty()) - sublist.append(iter.deref()); - list.append(quasiquote(new Mal.List(sublist))); - return new Mal.List(list); + if (ast is Mal.List) { + var unq = unquoted(ast, "unquote"); + if (unq != null) { + return unq; + } else { + return qq_foldr((ast as Mal.List).iter()); } + } else if (ast is Mal.Vector) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("vec")); + list.vs.append(qq_foldr((ast as Mal.Vector).iter())); + return list; + } else if (ast is Mal.Sym || ast is Mal.Hashmap) { + var list = new Mal.List.empty(); + list.vs.append(new Mal.Sym("quote")); + list.vs.append(ast); + return list; + } else { + return ast; } - - var list = new GLib.List(); - list.append(new Mal.Sym("cons")); - list.append(quasiquote(first)); - var sublist = new GLib.List(); - while (!iter.step().empty()) - sublist.append(iter.deref()); - list.append(quasiquote(new Mal.List(sublist))); - return new Mal.List(list); } public static bool is_macro_call(Mal.Val v, Mal.Env env) @@ -272,6 +289,11 @@ class Mal.Main : GLib.Object { throw new Mal.Error.BAD_PARAMS( "quote: expected one argument"); return list.next.data; + case "quasiquoteexpand": + if (list.length() != 2) + throw new Mal.Error.BAD_PARAMS( + "quasiquoteexpand: expected one argument"); + return quasiquote(list.next.data); case "quasiquote": if (list.length() != 2) throw new Mal.Error.BAD_PARAMS( diff --git a/impls/vala/types.vala b/impls/vala/types.vala index cb8d005c..11e4a30a 100644 --- a/impls/vala/types.vala +++ b/impls/vala/types.vala @@ -286,8 +286,3 @@ class Mal.Atom : Mal.Val { visit(v); } } - -bool is_pair(Mal.Val v) { - var listlike = v as Mal.Listlike; - return listlike != null && listlike.iter().nonempty(); -} diff --git a/impls/vb/core.vb b/impls/vb/core.vb index 6534de5a..08d3caf3 100644 --- a/impls/vb/core.vb +++ b/impls/vb/core.vb @@ -316,6 +316,10 @@ Namespace Mal return DirectCast(new MalList(lst),MalVal) End Function + Shared Function vec(a As MalList) As MalVal + return New MalVector(DirectCast(a(0),MalList).getValue()) + End Function + Shared Function nth(a As MalList) As MalVal Dim idx As Integer = DirectCast(a(1),MalInt).getValue() If (idx < DirectCast(a(0),MalList).size()) Then @@ -515,6 +519,7 @@ Namespace Mal ns.Add("sequential?", New MalFunc(AddressOf sequential_Q)) ns.Add("cons", New MalFunc(AddressOf cons)) ns.Add("concat", New MalFunc(AddressOf concat)) + ns.Add("vec", New MalFunc(AddressOf vec)) ns.Add("nth", New MalFunc(AddressOf nth)) ns.Add("first", New MalFunc(AddressOf first)) ns.Add("rest", New MalFunc(AddressOf rest)) diff --git a/impls/vb/step7_quote.vb b/impls/vb/step7_quote.vb index f3ea0309..3303f318 100644 --- a/impls/vb/step7_quote.vb +++ b/impls/vb/step7_quote.vb @@ -20,32 +20,45 @@ Namespace Mal End Function ' eval - Shared Function is_pair(x As MalVal) As Boolean - return TypeOf x Is MalList AndAlso _ - DirectCast(x,MalList).size() > 0 + Shared Function starts_with(ast As Malval, sym As String) As MalVal + If ast.list_Q() Then + Const lst As MalList = DirectCast(ast, MalList) + If 0 < lst.size() Then + Const fst As MalSymbol = TryCast(lst(0), MalSymbol) + If fst IsNot Nothing AndAlso fst.getName() = sym Then + return lst(1) + End If + End If + End If + return Nothing End Function Shared Function quasiquote(ast As MalVal) As MalVal - If not is_pair(ast) Then + If TypeOf ast Is Mal.types.MalSymbol or Typeof ast Is Mal.types.MalHashMap Then return New MalList(New MalSymbol("quote"), ast) - Else - Dim a0 As MalVal = DirectCast(ast,MalList)(0) - If TypeOf a0 Is MalSymbol AndAlso _ - DirectCast(a0,MalSymbol).getName() = "unquote" Then - return DirectCast(ast,MalList)(1) - Else If is_pair(a0) Then - Dim a00 As MalVal = DirectCast(a0,MalList)(0) - If TypeOf a00 is MalSymbol AndAlso _ - DirectCast(a00,MalSymbol).getName() = "splice-unquote" Then - return New MalList(New MalSymbol("concat"), - DirectCast(a0,MalList)(1), - quasiquote(DirectCast(ast,MalList).rest())) - End If - End If - return New MalList(New MalSymbol("cons"), - quasiquote(a0), - quasiquote(DirectCast(ast,MalList).rest())) End If + Const source As MalList = TryCast(ast, MalList) + If source Is Nothing Then + return ast + End If + Const unquoted As MalVal = starts_with(ast, "unquote") + If unquoted IsNot Nothing Then + return unquoted + End If + Dim result As MalList = New MalList() + For i As Integer = source.size()-1 To 0 Step -1 + Const elt As MalVal = source(i) + Const splice_unquoted As MalVal = starts_with(elt, "splice-unquote") + If splice_unquoted IsNot Nothing Then + result = New MalList(New MalSymbol("concat"), splice_unquoted, result) + Else + result = New MalList(New MalSymbol("cons"), quasiquote(elt), result) + End If + Next + If TypeOf ast Is MalVector Then + result = New MalList(New MalSymbol("vec"), result) + End If + return result End Function @@ -131,6 +144,8 @@ Namespace Mal env = let_env Case "quote" return ast(1) + Case "quasiquoteexpand" + return quasiquote(ast(1)) Case "quasiquote" orig_ast = quasiquote(ast(1)) Case "do" diff --git a/impls/vb/step8_macros.vb b/impls/vb/step8_macros.vb index a07d0724..43befb9e 100644 --- a/impls/vb/step8_macros.vb +++ b/impls/vb/step8_macros.vb @@ -20,32 +20,45 @@ Namespace Mal End Function ' eval - Shared Function is_pair(x As MalVal) As Boolean - return TypeOf x Is MalList AndAlso _ - DirectCast(x,MalList).size() > 0 + Shared Function starts_with(ast As Malval, sym As String) As MalVal + If ast.list_Q() Then + Const lst As MalList = DirectCast(ast, MalList) + If 0 < lst.size() Then + Const fst As MalSymbol = TryCast(lst(0), MalSymbol) + If fst IsNot Nothing AndAlso fst.getName() = sym Then + return lst(1) + End If + End If + End If + return Nothing End Function Shared Function quasiquote(ast As MalVal) As MalVal - If not is_pair(ast) Then + If TypeOf ast Is Mal.types.MalSymbol or Typeof ast Is Mal.types.MalHashMap Then return New MalList(New MalSymbol("quote"), ast) - Else - Dim a0 As MalVal = DirectCast(ast,MalList)(0) - If TypeOf a0 Is MalSymbol AndAlso _ - DirectCast(a0,MalSymbol).getName() = "unquote" Then - return DirectCast(ast,MalList)(1) - Else If is_pair(a0) Then - Dim a00 As MalVal = DirectCast(a0,MalList)(0) - If TypeOf a00 is MalSymbol AndAlso _ - DirectCast(a00,MalSymbol).getName() = "splice-unquote" Then - return New MalList(New MalSymbol("concat"), - DirectCast(a0,MalList)(1), - quasiquote(DirectCast(ast,MalList).rest())) - End If - End If - return New MalList(New MalSymbol("cons"), - quasiquote(a0), - quasiquote(DirectCast(ast,MalList).rest())) End If + Const source As MalList = TryCast(ast, MalList) + If source Is Nothing Then + return ast + End If + Const unquoted As MalVal = starts_with(ast, "unquote") + If unquoted IsNot Nothing Then + return unquoted + End If + Dim result As MalList = New MalList() + For i As Integer = source.size()-1 To 0 Step -1 + Const elt As MalVal = source(i) + Const splice_unquoted As MalVal = starts_with(elt, "splice-unquote") + If splice_unquoted IsNot Nothing Then + result = New MalList(New MalSymbol("concat"), splice_unquoted, result) + Else + result = New MalList(New MalSymbol("cons"), quasiquote(elt), result) + End If + Next + If TypeOf ast Is MalVector Then + result = New MalList(New MalSymbol("vec"), result) + End If + return result End Function Shared Function is_macro_call(ast As MalVal, env As MalEnv) As Boolean @@ -159,6 +172,8 @@ Namespace Mal env = let_env Case "quote" return ast(1) + Case "quasiquoteexpand" + return quasiquote(ast(1)) Case "quasiquote" orig_ast = quasiquote(ast(1)) Case "defmacro!" diff --git a/impls/vb/step9_try.vb b/impls/vb/step9_try.vb index b184c963..e8f35a0b 100644 --- a/impls/vb/step9_try.vb +++ b/impls/vb/step9_try.vb @@ -20,32 +20,45 @@ Namespace Mal End Function ' eval - Shared Function is_pair(x As MalVal) As Boolean - return TypeOf x Is MalList AndAlso _ - DirectCast(x,MalList).size() > 0 + Shared Function starts_with(ast As Malval, sym As String) As MalVal + If ast.list_Q() Then + Const lst As MalList = DirectCast(ast, MalList) + If 0 < lst.size() Then + Const fst As MalSymbol = TryCast(lst(0), MalSymbol) + If fst IsNot Nothing AndAlso fst.getName() = sym Then + return lst(1) + End If + End If + End If + return Nothing End Function Shared Function quasiquote(ast As MalVal) As MalVal - If not is_pair(ast) Then + If TypeOf ast Is Mal.types.MalSymbol or Typeof ast Is Mal.types.MalHashMap Then return New MalList(New MalSymbol("quote"), ast) - Else - Dim a0 As MalVal = DirectCast(ast,MalList)(0) - If TypeOf a0 Is MalSymbol AndAlso _ - DirectCast(a0,MalSymbol).getName() = "unquote" Then - return DirectCast(ast,MalList)(1) - Else If is_pair(a0) Then - Dim a00 As MalVal = DirectCast(a0,MalList)(0) - If TypeOf a00 is MalSymbol AndAlso _ - DirectCast(a00,MalSymbol).getName() = "splice-unquote" Then - return New MalList(New MalSymbol("concat"), - DirectCast(a0,MalList)(1), - quasiquote(DirectCast(ast,MalList).rest())) - End If - End If - return New MalList(New MalSymbol("cons"), - quasiquote(a0), - quasiquote(DirectCast(ast,MalList).rest())) End If + Const source As MalList = TryCast(ast, MalList) + If source Is Nothing Then + return ast + End If + Const unquoted As MalVal = starts_with(ast, "unquote") + If unquoted IsNot Nothing Then + return unquoted + End If + Dim result As MalList = New MalList() + For i As Integer = source.size()-1 To 0 Step -1 + Const elt As MalVal = source(i) + Const splice_unquoted As MalVal = starts_with(elt, "splice-unquote") + If splice_unquoted IsNot Nothing Then + result = New MalList(New MalSymbol("concat"), splice_unquoted, result) + Else + result = New MalList(New MalSymbol("cons"), quasiquote(elt), result) + End If + Next + If TypeOf ast Is MalVector Then + result = New MalList(New MalSymbol("vec"), result) + End If + return result End Function Shared Function is_macro_call(ast As MalVal, env As MalEnv) As Boolean @@ -159,6 +172,8 @@ Namespace Mal env = let_env Case "quote" return ast(1) + Case "quasiquoteexpand" + return quasiquote(ast(1)) Case "quasiquote" orig_ast = quasiquote(ast(1)) Case "defmacro!" diff --git a/impls/vb/stepA_mal.vb b/impls/vb/stepA_mal.vb index 1e99f79a..ba289f5c 100644 --- a/impls/vb/stepA_mal.vb +++ b/impls/vb/stepA_mal.vb @@ -20,32 +20,45 @@ Namespace Mal End Function ' eval - Shared Function is_pair(x As MalVal) As Boolean - return TypeOf x Is MalList AndAlso _ - DirectCast(x,MalList).size() > 0 + Shared Function starts_with(ast As Malval, sym As String) As MalVal + If ast.list_Q() Then + Const lst As MalList = DirectCast(ast, MalList) + If 0 < lst.size() Then + Const fst As MalSymbol = TryCast(lst(0), MalSymbol) + If fst IsNot Nothing AndAlso fst.getName() = sym Then + return lst(1) + End If + End If + End If + return Nothing End Function Shared Function quasiquote(ast As MalVal) As MalVal - If not is_pair(ast) Then + If TypeOf ast Is Mal.types.MalSymbol or Typeof ast Is Mal.types.MalHashMap Then return New MalList(New MalSymbol("quote"), ast) - Else - Dim a0 As MalVal = DirectCast(ast,MalList)(0) - If TypeOf a0 Is MalSymbol AndAlso _ - DirectCast(a0,MalSymbol).getName() = "unquote" Then - return DirectCast(ast,MalList)(1) - Else If is_pair(a0) Then - Dim a00 As MalVal = DirectCast(a0,MalList)(0) - If TypeOf a00 is MalSymbol AndAlso _ - DirectCast(a00,MalSymbol).getName() = "splice-unquote" Then - return New MalList(New MalSymbol("concat"), - DirectCast(a0,MalList)(1), - quasiquote(DirectCast(ast,MalList).rest())) - End If - End If - return New MalList(New MalSymbol("cons"), - quasiquote(a0), - quasiquote(DirectCast(ast,MalList).rest())) End If + Const source As MalList = TryCast(ast, MalList) + If source Is Nothing Then + return ast + End If + Const unquoted As MalVal = starts_with(ast, "unquote") + If unquoted IsNot Nothing Then + return unquoted + End If + Dim result As MalList = New MalList() + For i As Integer = source.size()-1 To 0 Step -1 + Const elt As MalVal = source(i) + Const splice_unquoted As MalVal = starts_with(elt, "splice-unquote") + If splice_unquoted IsNot Nothing Then + result = New MalList(New MalSymbol("concat"), splice_unquoted, result) + Else + result = New MalList(New MalSymbol("cons"), quasiquote(elt), result) + End If + Next + If TypeOf ast Is MalVector Then + result = New MalList(New MalSymbol("vec"), result) + End If + return result End Function Shared Function is_macro_call(ast As MalVal, env As MalEnv) As Boolean @@ -159,6 +172,8 @@ Namespace Mal env = let_env Case "quote" return ast(1) + Case "quasiquoteexpand" + return quasiquote(ast(1)) Case "quasiquote" orig_ast = quasiquote(ast(1)) Case "defmacro!" diff --git a/impls/vhdl/core.vhdl b/impls/vhdl/core.vhdl index d228e246..2b652367 100644 --- a/impls/vhdl/core.vhdl +++ b/impls/vhdl/core.vhdl @@ -375,6 +375,15 @@ package body core is new_seq_obj(mal_list, seq, result); end procedure fn_concat; + procedure fn_vec(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + begin + if args.seq_val(0).val_type = mal_vector then + result := args.seq_val(0); + else + new_seq_obj(mal_vector, args.seq_val(0).seq_val, result); + end if; + end procedure fn_vec; + procedure fn_nth(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is variable lst_seq: mal_seq_ptr := args.seq_val(0).seq_val; variable index: integer := args.seq_val(1).number_val; @@ -581,6 +590,7 @@ package body core is elsif f.all = "sequential?" then fn_sequential_q(args, result, err); elsif f.all = "cons" then fn_cons(args, result, err); elsif f.all = "concat" then fn_concat(args, result, err); + elsif f.all = "vec" then fn_vec(args, result, err); elsif f.all = "nth" then fn_nth(args, result, err); elsif f.all = "first" then fn_first(args, result, err); elsif f.all = "rest" then fn_rest(args, result, err); @@ -654,6 +664,7 @@ package body core is define_core_function(e, "sequential?"); define_core_function(e, "cons"); define_core_function(e, "concat"); + define_core_function(e, "vec"); define_core_function(e, "nth"); define_core_function(e, "first"); define_core_function(e, "rest"); diff --git a/impls/vhdl/step7_quote.vhdl b/impls/vhdl/step7_quote.vhdl index 241fae79..d24b2935 100644 --- a/impls/vhdl/step7_quote.vhdl +++ b/impls/vhdl/step7_quote.vhdl @@ -20,45 +20,76 @@ architecture test of step7_quote is read_str(str, ast, err); end procedure mal_READ; - procedure is_pair(ast: inout mal_val_ptr; pair: out boolean) is + procedure starts_with(lst : inout mal_val_ptr; + sym : in string; + res : out boolean) is begin - pair := is_sequential_type(ast.val_type) and ast.seq_val'length > 0; - end procedure is_pair; + res := lst.seq_val.all'length = 2 + and lst.seq_val.all (lst.seq_val.all'low).val_type = mal_symbol + and lst.seq_val.all (lst.seq_val.all'low).string_val.all = sym; + end starts_with; - procedure quasiquote(ast: inout mal_val_ptr; result: out mal_val_ptr) is - variable ast_pair, a0_pair: boolean; - variable seq: mal_seq_ptr; - variable a0, rest: mal_val_ptr; + -- Forward declaration + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr); + + procedure qq_loop(elt : inout mal_val_ptr; + acc : inout mal_val_ptr) is + variable sw : boolean := elt.val_type = mal_list; + variable seq : mal_seq_ptr := new mal_seq(0 to 2); begin - is_pair(ast, ast_pair); - if not ast_pair then - seq := new mal_seq(0 to 1); - new_symbol("quote", seq(0)); - seq(1) := ast; - new_seq_obj(mal_list, seq, result); - return; + if sw then + starts_with(elt, "splice-unquote", sw); end if; - a0 := ast.seq_val(0); - if a0.val_type = mal_symbol and a0.string_val.all = "unquote" then - result := ast.seq_val(1); + if sw then + new_symbol("concat", seq(0)); + seq(1) := elt.seq_val(1); else - is_pair(a0, a0_pair); - if a0_pair and a0.seq_val(0).val_type = mal_symbol and a0.seq_val(0).string_val.all = "splice-unquote" then - seq := new mal_seq(0 to 2); - new_symbol("concat", seq(0)); - seq(1) := a0.seq_val(1); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - else - seq := new mal_seq(0 to 2); - new_symbol("cons", seq(0)); - quasiquote(a0, seq(1)); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - end if; + new_symbol("cons", seq(0)); + quasiquote(elt, seq(1)); end if; + seq(2) := acc; + new_seq_obj(mal_list, seq, acc); + end qq_loop; + + procedure qq_foldr (xs : inout mal_seq_ptr; + res : out mal_val_ptr) is + variable seq : mal_seq_ptr := new mal_seq(0 to -1); + variable acc : mal_val_ptr; + begin + new_seq_obj(mal_list, seq, acc); + for i in xs'reverse_range loop + qq_loop (xs(i), acc); + end loop; + res := acc; + end procedure qq_foldr; + + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr) is + variable sw : boolean; + variable seq : mal_seq_ptr; + begin + case ast.val_type is + when mal_list => + starts_with(ast, "unquote", sw); + if sw then + result := ast.seq_val(1); + else + qq_foldr(ast.seq_val, result); + end if; + when mal_vector => + seq := new mal_seq(0 to 1); + new_symbol("vec", seq(0)); + qq_foldr(ast.seq_val, seq(1)); + new_seq_obj(mal_list, seq, result); + when mal_symbol | mal_hashmap => + seq := new mal_seq(0 to 1); + new_symbol("quote", seq(0)); + seq(1) := ast; + new_seq_obj(mal_list, seq, result); + when others => + result := ast; + end case; end procedure quasiquote; -- Forward declaration @@ -208,6 +239,10 @@ architecture test of step7_quote is result := ast.seq_val(1); return; + elsif a0.string_val.all = "quasiquoteexpand" then + quasiquote(ast.seq_val(1), result); + return; + elsif a0.string_val.all = "quasiquote" then quasiquote(ast.seq_val(1), ast); next; -- TCO diff --git a/impls/vhdl/step8_macros.vhdl b/impls/vhdl/step8_macros.vhdl index 66b1174c..9cc740ee 100644 --- a/impls/vhdl/step8_macros.vhdl +++ b/impls/vhdl/step8_macros.vhdl @@ -20,45 +20,76 @@ architecture test of step8_macros is read_str(str, ast, err); end procedure mal_READ; - procedure is_pair(ast: inout mal_val_ptr; pair: out boolean) is + procedure starts_with(lst : inout mal_val_ptr; + sym : in string; + res : out boolean) is begin - pair := is_sequential_type(ast.val_type) and ast.seq_val'length > 0; - end procedure is_pair; + res := lst.seq_val.all'length = 2 + and lst.seq_val.all (lst.seq_val.all'low).val_type = mal_symbol + and lst.seq_val.all (lst.seq_val.all'low).string_val.all = sym; + end starts_with; - procedure quasiquote(ast: inout mal_val_ptr; result: out mal_val_ptr) is - variable ast_pair, a0_pair: boolean; - variable seq: mal_seq_ptr; - variable a0, rest: mal_val_ptr; + -- Forward declaration + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr); + + procedure qq_loop(elt : inout mal_val_ptr; + acc : inout mal_val_ptr) is + variable sw : boolean := elt.val_type = mal_list; + variable seq : mal_seq_ptr := new mal_seq(0 to 2); begin - is_pair(ast, ast_pair); - if not ast_pair then - seq := new mal_seq(0 to 1); - new_symbol("quote", seq(0)); - seq(1) := ast; - new_seq_obj(mal_list, seq, result); - return; + if sw then + starts_with(elt, "splice-unquote", sw); end if; - a0 := ast.seq_val(0); - if a0.val_type = mal_symbol and a0.string_val.all = "unquote" then - result := ast.seq_val(1); + if sw then + new_symbol("concat", seq(0)); + seq(1) := elt.seq_val(1); else - is_pair(a0, a0_pair); - if a0_pair and a0.seq_val(0).val_type = mal_symbol and a0.seq_val(0).string_val.all = "splice-unquote" then - seq := new mal_seq(0 to 2); - new_symbol("concat", seq(0)); - seq(1) := a0.seq_val(1); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - else - seq := new mal_seq(0 to 2); - new_symbol("cons", seq(0)); - quasiquote(a0, seq(1)); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - end if; + new_symbol("cons", seq(0)); + quasiquote(elt, seq(1)); end if; + seq(2) := acc; + new_seq_obj(mal_list, seq, acc); + end qq_loop; + + procedure qq_foldr (xs : inout mal_seq_ptr; + res : out mal_val_ptr) is + variable seq : mal_seq_ptr := new mal_seq(0 to -1); + variable acc : mal_val_ptr; + begin + new_seq_obj(mal_list, seq, acc); + for i in xs'reverse_range loop + qq_loop (xs(i), acc); + end loop; + res := acc; + end procedure qq_foldr; + + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr) is + variable sw : boolean; + variable seq : mal_seq_ptr; + begin + case ast.val_type is + when mal_list => + starts_with(ast, "unquote", sw); + if sw then + result := ast.seq_val(1); + else + qq_foldr(ast.seq_val, result); + end if; + when mal_vector => + seq := new mal_seq(0 to 1); + new_symbol("vec", seq(0)); + qq_foldr(ast.seq_val, seq(1)); + new_seq_obj(mal_list, seq, result); + when mal_symbol | mal_hashmap => + seq := new mal_seq(0 to 1); + new_symbol("quote", seq(0)); + seq(1) := ast; + new_seq_obj(mal_list, seq, result); + when others => + result := ast; + end case; end procedure quasiquote; -- Forward declaration @@ -251,6 +282,10 @@ architecture test of step8_macros is result := ast.seq_val(1); return; + elsif a0.string_val.all = "quasiquoteexpand" then + quasiquote(ast.seq_val(1), result); + return; + elsif a0.string_val.all = "quasiquote" then quasiquote(ast.seq_val(1), ast); next; -- TCO diff --git a/impls/vhdl/step9_try.vhdl b/impls/vhdl/step9_try.vhdl index 217d5030..ad9612f2 100644 --- a/impls/vhdl/step9_try.vhdl +++ b/impls/vhdl/step9_try.vhdl @@ -20,45 +20,76 @@ architecture test of step9_try is read_str(str, ast, err); end procedure mal_READ; - procedure is_pair(ast: inout mal_val_ptr; pair: out boolean) is + procedure starts_with(lst : inout mal_val_ptr; + sym : in string; + res : out boolean) is begin - pair := is_sequential_type(ast.val_type) and ast.seq_val'length > 0; - end procedure is_pair; + res := lst.seq_val.all'length = 2 + and lst.seq_val.all (lst.seq_val.all'low).val_type = mal_symbol + and lst.seq_val.all (lst.seq_val.all'low).string_val.all = sym; + end starts_with; - procedure quasiquote(ast: inout mal_val_ptr; result: out mal_val_ptr) is - variable ast_pair, a0_pair: boolean; - variable seq: mal_seq_ptr; - variable a0, rest: mal_val_ptr; + -- Forward declaration + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr); + + procedure qq_loop(elt : inout mal_val_ptr; + acc : inout mal_val_ptr) is + variable sw : boolean := elt.val_type = mal_list; + variable seq : mal_seq_ptr := new mal_seq(0 to 2); begin - is_pair(ast, ast_pair); - if not ast_pair then - seq := new mal_seq(0 to 1); - new_symbol("quote", seq(0)); - seq(1) := ast; - new_seq_obj(mal_list, seq, result); - return; + if sw then + starts_with(elt, "splice-unquote", sw); end if; - a0 := ast.seq_val(0); - if a0.val_type = mal_symbol and a0.string_val.all = "unquote" then - result := ast.seq_val(1); + if sw then + new_symbol("concat", seq(0)); + seq(1) := elt.seq_val(1); else - is_pair(a0, a0_pair); - if a0_pair and a0.seq_val(0).val_type = mal_symbol and a0.seq_val(0).string_val.all = "splice-unquote" then - seq := new mal_seq(0 to 2); - new_symbol("concat", seq(0)); - seq(1) := a0.seq_val(1); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - else - seq := new mal_seq(0 to 2); - new_symbol("cons", seq(0)); - quasiquote(a0, seq(1)); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - end if; + new_symbol("cons", seq(0)); + quasiquote(elt, seq(1)); end if; + seq(2) := acc; + new_seq_obj(mal_list, seq, acc); + end qq_loop; + + procedure qq_foldr (xs : inout mal_seq_ptr; + res : out mal_val_ptr) is + variable seq : mal_seq_ptr := new mal_seq(0 to -1); + variable acc : mal_val_ptr; + begin + new_seq_obj(mal_list, seq, acc); + for i in xs'reverse_range loop + qq_loop (xs(i), acc); + end loop; + res := acc; + end procedure qq_foldr; + + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr) is + variable sw : boolean; + variable seq : mal_seq_ptr; + begin + case ast.val_type is + when mal_list => + starts_with(ast, "unquote", sw); + if sw then + result := ast.seq_val(1); + else + qq_foldr(ast.seq_val, result); + end if; + when mal_vector => + seq := new mal_seq(0 to 1); + new_symbol("vec", seq(0)); + qq_foldr(ast.seq_val, seq(1)); + new_seq_obj(mal_list, seq, result); + when mal_symbol | mal_hashmap => + seq := new mal_seq(0 to 1); + new_symbol("quote", seq(0)); + seq(1) := ast; + new_seq_obj(mal_list, seq, result); + when others => + result := ast; + end case; end procedure quasiquote; -- Forward declaration @@ -291,6 +322,10 @@ architecture test of step9_try is result := ast.seq_val(1); return; + elsif a0.string_val.all = "quasiquoteexpand" then + quasiquote(ast.seq_val(1), result); + return; + elsif a0.string_val.all = "quasiquote" then quasiquote(ast.seq_val(1), ast); next; -- TCO diff --git a/impls/vhdl/stepA_mal.vhdl b/impls/vhdl/stepA_mal.vhdl index 5cc6b26d..3b461d2d 100644 --- a/impls/vhdl/stepA_mal.vhdl +++ b/impls/vhdl/stepA_mal.vhdl @@ -20,45 +20,76 @@ architecture test of stepA_mal is read_str(str, ast, err); end procedure mal_READ; - procedure is_pair(ast: inout mal_val_ptr; pair: out boolean) is + procedure starts_with(lst : inout mal_val_ptr; + sym : in string; + res : out boolean) is begin - pair := is_sequential_type(ast.val_type) and ast.seq_val'length > 0; - end procedure is_pair; + res := lst.seq_val.all'length = 2 + and lst.seq_val.all (lst.seq_val.all'low).val_type = mal_symbol + and lst.seq_val.all (lst.seq_val.all'low).string_val.all = sym; + end starts_with; - procedure quasiquote(ast: inout mal_val_ptr; result: out mal_val_ptr) is - variable ast_pair, a0_pair: boolean; - variable seq: mal_seq_ptr; - variable a0, rest: mal_val_ptr; + -- Forward declaration + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr); + + procedure qq_loop(elt : inout mal_val_ptr; + acc : inout mal_val_ptr) is + variable sw : boolean := elt.val_type = mal_list; + variable seq : mal_seq_ptr := new mal_seq(0 to 2); begin - is_pair(ast, ast_pair); - if not ast_pair then - seq := new mal_seq(0 to 1); - new_symbol("quote", seq(0)); - seq(1) := ast; - new_seq_obj(mal_list, seq, result); - return; + if sw then + starts_with(elt, "splice-unquote", sw); end if; - a0 := ast.seq_val(0); - if a0.val_type = mal_symbol and a0.string_val.all = "unquote" then - result := ast.seq_val(1); + if sw then + new_symbol("concat", seq(0)); + seq(1) := elt.seq_val(1); else - is_pair(a0, a0_pair); - if a0_pair and a0.seq_val(0).val_type = mal_symbol and a0.seq_val(0).string_val.all = "splice-unquote" then - seq := new mal_seq(0 to 2); - new_symbol("concat", seq(0)); - seq(1) := a0.seq_val(1); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - else - seq := new mal_seq(0 to 2); - new_symbol("cons", seq(0)); - quasiquote(a0, seq(1)); - seq_drop_prefix(ast, 1, rest); - quasiquote(rest, seq(2)); - new_seq_obj(mal_list, seq, result); - end if; + new_symbol("cons", seq(0)); + quasiquote(elt, seq(1)); end if; + seq(2) := acc; + new_seq_obj(mal_list, seq, acc); + end qq_loop; + + procedure qq_foldr (xs : inout mal_seq_ptr; + res : out mal_val_ptr) is + variable seq : mal_seq_ptr := new mal_seq(0 to -1); + variable acc : mal_val_ptr; + begin + new_seq_obj(mal_list, seq, acc); + for i in xs'reverse_range loop + qq_loop (xs(i), acc); + end loop; + res := acc; + end procedure qq_foldr; + + procedure quasiquote(ast: inout mal_val_ptr; + result: out mal_val_ptr) is + variable sw : boolean; + variable seq : mal_seq_ptr; + begin + case ast.val_type is + when mal_list => + starts_with(ast, "unquote", sw); + if sw then + result := ast.seq_val(1); + else + qq_foldr(ast.seq_val, result); + end if; + when mal_vector => + seq := new mal_seq(0 to 1); + new_symbol("vec", seq(0)); + qq_foldr(ast.seq_val, seq(1)); + new_seq_obj(mal_list, seq, result); + when mal_symbol | mal_hashmap => + seq := new mal_seq(0 to 1); + new_symbol("quote", seq(0)); + seq(1) := ast; + new_seq_obj(mal_list, seq, result); + when others => + result := ast; + end case; end procedure quasiquote; -- Forward declaration @@ -291,6 +322,10 @@ architecture test of stepA_mal is result := ast.seq_val(1); return; + elsif a0.string_val.all = "quasiquoteexpand" then + quasiquote(ast.seq_val(1), result); + return; + elsif a0.string_val.all = "quasiquote" then quasiquote(ast.seq_val(1), ast); next; -- TCO diff --git a/impls/vimscript/core.vim b/impls/vimscript/core.vim index 5dfda330..fc4cfa4e 100644 --- a/impls/vimscript/core.vim +++ b/impls/vimscript/core.vim @@ -215,6 +215,7 @@ let CoreNs = { \ "slurp": NewNativeFnLambda({a -> StringNew(join(readfile(a[0].val, "b"), "\n"))}), \ "cons": NewNativeFn("MalCons"), \ "concat": NewNativeFn("MalConcat"), + \ "vec": NewNativeFnLambda({a -> VectorNew(a[0].val)}), \ "first": NewNativeFnLambda({a -> NilQ(a[0]) ? g:MalNil : ListFirst(a[0])}), \ "nth": NewNativeFnLambda({a -> ListNth(a[0], a[1].val)}), \ "rest": NewNativeFnLambda({a -> NilQ(a[0]) ? ListNew([]) : ListRest(a[0])}), diff --git a/impls/vimscript/step7_quote.vim b/impls/vimscript/step7_quote.vim index a634c059..c7507d82 100644 --- a/impls/vimscript/step7_quote.vim +++ b/impls/vimscript/step7_quote.vim @@ -9,22 +9,39 @@ function READ(str) return ReadStr(a:str) endfunction -function PairQ(obj) - return SequentialQ(a:obj) && !EmptyQ(a:obj) +function StartsWith(ast, sym) + if EmptyQ(a:ast) + return 0 + endif + let fst = ListFirst(a:ast) + return SymbolQ(fst) && fst.val == a:sym endfunction +function QuasiquoteLoop(xs) + let revlist = reverse(copy(a:xs)) + let acc = ListNew([]) + for elt in revlist + if ListQ(elt) && StartsWith(elt, "splice-unquote") + let acc = ListNew([SymbolNew("concat"), ListNth(elt, 1), acc]) + else + let acc = ListNew([SymbolNew("cons"), Quasiquote(elt), acc]) + endif + endfor + return acc + endfunction + function Quasiquote(ast) - if !PairQ(a:ast) + if VectorQ(a:ast) + return ListNew([SymbolNew("vec"), QuasiquoteLoop(a:ast.val)]) + elseif SymbolQ(a:ast) || HashQ(a:ast) return ListNew([SymbolNew("quote"), a:ast]) - endif - let a0 = ListFirst(a:ast) - if SymbolQ(a0) && a0.val == "unquote" + elseif !ListQ(a:ast) + return a:ast + elseif StartsWith(a:ast, "unquote") return ListNth(a:ast, 1) - elseif PairQ(a0) && SymbolQ(ListFirst(a0)) && ListFirst(a0).val == "splice-unquote" - return ListNew([SymbolNew("concat"), ListNth(a0, 1), Quasiquote(ListRest(a:ast))]) else - return ListNew([SymbolNew("cons"), Quasiquote(a0), Quasiquote(ListRest(a:ast))]) - end + return QuasiquoteLoop(a:ast.val) + endif endfunction function EvalAst(ast, env) @@ -83,6 +100,8 @@ function EVAL(ast, env) " TCO elseif first_symbol == "quote" return ListNth(ast, 1) + elseif first_symbol == "quasiquoteexpand" + return Quasiquote(ListNth(ast, 1)) elseif first_symbol == "quasiquote" let ast = Quasiquote(ListNth(ast, 1)) " TCO diff --git a/impls/vimscript/step8_macros.vim b/impls/vimscript/step8_macros.vim index 770d7ae4..d0f2f00a 100644 --- a/impls/vimscript/step8_macros.vim +++ b/impls/vimscript/step8_macros.vim @@ -9,22 +9,39 @@ function READ(str) return ReadStr(a:str) endfunction -function PairQ(obj) - return SequentialQ(a:obj) && !EmptyQ(a:obj) +function StartsWith(ast, sym) + if EmptyQ(a:ast) + return 0 + endif + let fst = ListFirst(a:ast) + return SymbolQ(fst) && fst.val == a:sym endfunction +function QuasiquoteLoop(xs) + let revlist = reverse(copy(a:xs)) + let acc = ListNew([]) + for elt in revlist + if ListQ(elt) && StartsWith(elt, "splice-unquote") + let acc = ListNew([SymbolNew("concat"), ListNth(elt, 1), acc]) + else + let acc = ListNew([SymbolNew("cons"), Quasiquote(elt), acc]) + endif + endfor + return acc + endfunction + function Quasiquote(ast) - if !PairQ(a:ast) + if VectorQ(a:ast) + return ListNew([SymbolNew("vec"), QuasiquoteLoop(a:ast.val)]) + elseif SymbolQ(a:ast) || HashQ(a:ast) return ListNew([SymbolNew("quote"), a:ast]) - endif - let a0 = ListFirst(a:ast) - if SymbolQ(a0) && a0.val == "unquote" + elseif !ListQ(a:ast) + return a:ast + elseif StartsWith(a:ast, "unquote") return ListNth(a:ast, 1) - elseif PairQ(a0) && SymbolQ(ListFirst(a0)) && ListFirst(a0).val == "splice-unquote" - return ListNew([SymbolNew("concat"), ListNth(a0, 1), Quasiquote(ListRest(a:ast))]) else - return ListNew([SymbolNew("cons"), Quasiquote(a0), Quasiquote(ListRest(a:ast))]) - end + return QuasiquoteLoop(a:ast.val) + endif endfunction function IsMacroCall(ast, env) @@ -112,6 +129,8 @@ function EVAL(ast, env) " TCO elseif first_symbol == "quote" return ListNth(ast, 1) + elseif first_symbol == "quasiquoteexpand" + return Quasiquote(ListNth(ast, 1)) elseif first_symbol == "quasiquote" let ast = Quasiquote(ListNth(ast, 1)) " TCO diff --git a/impls/vimscript/step9_try.vim b/impls/vimscript/step9_try.vim index 6dabcdf2..da31eb80 100644 --- a/impls/vimscript/step9_try.vim +++ b/impls/vimscript/step9_try.vim @@ -11,22 +11,39 @@ function READ(str) return ReadStr(a:str) endfunction -function PairQ(obj) - return SequentialQ(a:obj) && !EmptyQ(a:obj) +function StartsWith(ast, sym) + if EmptyQ(a:ast) + return 0 + endif + let fst = ListFirst(a:ast) + return SymbolQ(fst) && fst.val == a:sym endfunction +function QuasiquoteLoop(xs) + let revlist = reverse(copy(a:xs)) + let acc = ListNew([]) + for elt in revlist + if ListQ(elt) && StartsWith(elt, "splice-unquote") + let acc = ListNew([SymbolNew("concat"), ListNth(elt, 1), acc]) + else + let acc = ListNew([SymbolNew("cons"), Quasiquote(elt), acc]) + endif + endfor + return acc + endfunction + function Quasiquote(ast) - if !PairQ(a:ast) + if VectorQ(a:ast) + return ListNew([SymbolNew("vec"), QuasiquoteLoop(a:ast.val)]) + elseif SymbolQ(a:ast) || HashQ(a:ast) return ListNew([SymbolNew("quote"), a:ast]) - endif - let a0 = ListFirst(a:ast) - if SymbolQ(a0) && a0.val == "unquote" + elseif !ListQ(a:ast) + return a:ast + elseif StartsWith(a:ast, "unquote") return ListNth(a:ast, 1) - elseif PairQ(a0) && SymbolQ(ListFirst(a0)) && ListFirst(a0).val == "splice-unquote" - return ListNew([SymbolNew("concat"), ListNth(a0, 1), Quasiquote(ListRest(a:ast))]) else - return ListNew([SymbolNew("cons"), Quasiquote(a0), Quasiquote(ListRest(a:ast))]) - end + return QuasiquoteLoop(a:ast.val) + endif endfunction function IsMacroCall(ast, env) @@ -126,6 +143,8 @@ function EVAL(ast, env) " TCO elseif first_symbol == "quote" return ListNth(ast, 1) + elseif first_symbol == "quasiquoteexpand" + return Quasiquote(ListNth(ast, 1)) elseif first_symbol == "quasiquote" let ast = Quasiquote(ListNth(ast, 1)) " TCO diff --git a/impls/vimscript/stepA_mal.vim b/impls/vimscript/stepA_mal.vim index 6661dd22..68ee6407 100644 --- a/impls/vimscript/stepA_mal.vim +++ b/impls/vimscript/stepA_mal.vim @@ -11,22 +11,39 @@ function READ(str) return ReadStr(a:str) endfunction -function PairQ(obj) - return SequentialQ(a:obj) && !EmptyQ(a:obj) +function StartsWith(ast, sym) + if EmptyQ(a:ast) + return 0 + endif + let fst = ListFirst(a:ast) + return SymbolQ(fst) && fst.val == a:sym endfunction +function QuasiquoteLoop(xs) + let revlist = reverse(copy(a:xs)) + let acc = ListNew([]) + for elt in revlist + if ListQ(elt) && StartsWith(elt, "splice-unquote") + let acc = ListNew([SymbolNew("concat"), ListNth(elt, 1), acc]) + else + let acc = ListNew([SymbolNew("cons"), Quasiquote(elt), acc]) + endif + endfor + return acc + endfunction + function Quasiquote(ast) - if !PairQ(a:ast) + if VectorQ(a:ast) + return ListNew([SymbolNew("vec"), QuasiquoteLoop(a:ast.val)]) + elseif SymbolQ(a:ast) || HashQ(a:ast) return ListNew([SymbolNew("quote"), a:ast]) - endif - let a0 = ListFirst(a:ast) - if SymbolQ(a0) && a0.val == "unquote" + elseif !ListQ(a:ast) + return a:ast + elseif StartsWith(a:ast, "unquote") return ListNth(a:ast, 1) - elseif PairQ(a0) && SymbolQ(ListFirst(a0)) && ListFirst(a0).val == "splice-unquote" - return ListNew([SymbolNew("concat"), ListNth(a0, 1), Quasiquote(ListRest(a:ast))]) else - return ListNew([SymbolNew("cons"), Quasiquote(a0), Quasiquote(ListRest(a:ast))]) - end + return QuasiquoteLoop(a:ast.val) + endif endfunction function IsMacroCall(ast, env) @@ -126,6 +143,8 @@ function EVAL(ast, env) " TCO elseif first_symbol == "quote" return ListNth(ast, 1) + elseif first_symbol == "quasiquoteexpand" + return Quasiquote(ListNth(ast, 1)) elseif first_symbol == "quasiquote" let ast = Quasiquote(ListNth(ast, 1)) " TCO diff --git a/impls/wasm/core.wam b/impls/wasm/core.wam index 9f7f68c4..add993aa 100644 --- a/impls/wasm/core.wam +++ b/impls/wasm/core.wam @@ -374,6 +374,9 @@ $res ) + (func $vec (param $args i32) (result i32) + ($FORCE_SEQ_TYPE (global.get $VECTOR_T) ($MEM_VAL1_ptr $args))) + (func $nth (param $args i32) (result i32) (LET $a ($MEM_VAL1_ptr $args) $idx ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))) @@ -650,6 +653,7 @@ $swap_BANG $pr_memory_summary + $vec ) ) @@ -722,5 +726,6 @@ (drop ($ENV_SET_S $env "swap!" ($FUNCTION 60))) (drop ($ENV_SET_S $env "pr-memory-summary" ($FUNCTION 61))) + (drop ($ENV_SET_S $env "vec" ($FUNCTION 62))) ) ) diff --git a/impls/wasm/step7_quote.wam b/impls/wasm/step7_quote.wam index fdbc2c24..0da34e3a 100644 --- a/impls/wasm/step7_quote.wam +++ b/impls/wasm/step7_quote.wam @@ -8,55 +8,85 @@ ) ;; EVAL - (func $is_pair (param $ast i32) (result i32) - (LET $type ($TYPE $ast)) - (AND (OR (i32.eq $type (global.get $LIST_T)) - (i32.eq $type (global.get $VECTOR_T))) - (i32.ne ($VAL0 $ast) 0)) - ) + (func $QUASIQUOTE (param $ast i32) (result i32) - (LET $res 0 $sym 0 $second 0 $third 0) - (if (i32.eqz ($is_pair $ast)) ;; QQ_QUOTE - (then - (local.set $sym ($STRING (global.get $SYMBOL_T) "quote")) - ;; ['quote ast] - (local.set $res ($LIST2 $sym $ast)) - ($RELEASE $sym)) - (else - (local.set $res ($MEM_VAL1_ptr $ast)) - (if (AND (i32.eq ($TYPE $res) (global.get $SYMBOL_T)) - (i32.eqz ($strcmp "unquote" ($to_String $res)))) - (then - ;; ast[1] - (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))))) - (else (if (AND ($is_pair $res) - (i32.eq ($TYPE ($MEM_VAL1_ptr $res)) - (global.get $SYMBOL_T)) - (i32.eqz ($strcmp "splice-unquote" - ($to_String ($MEM_VAL1_ptr $res))))) - (then - ;; ['concat, ast[0][1], quasiquote(ast[1..])] - (local.set $sym ($STRING (global.get $SYMBOL_T) "concat")) - (local.set $second - ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL1_ptr $ast)))) - (local.set $third ($QUASIQUOTE ($MEM_VAL0_ptr $ast))) - (local.set $res ($LIST3 $sym $second $third)) - ;; release inner quasiquoted since outer list take ownership - ($RELEASE $third) - ($RELEASE $sym)) - (else - ;; ['cons, quasiquote(ast[0]), quasiquote(ast[1..])] - (local.set $sym ($STRING (global.get $SYMBOL_T) "cons")) - (local.set $second ($QUASIQUOTE ($MEM_VAL1_ptr $ast))) - (local.set $third ($QUASIQUOTE ($MEM_VAL0_ptr $ast))) - (local.set $res ($LIST3 $sym $second $third)) - ;; release inner quasiquoted since outer list takes ownership - ($RELEASE $third) - ($RELEASE $second) - ($RELEASE $sym))))))) - $res - ) + (LET $type ($TYPE $ast) $res 0 $sym 0 $second 0) + + ;; symbol or map -> ('quote ast) + (if (OR (i32.eq $type (global.get $SYMBOL_T)) + (i32.eq $type (global.get $HASHMAP_T))) + (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "quote")) + (local.set $res ($LIST2 $sym $ast)) + ($RELEASE $sym) + (return $res))) + + ;; [xs..] -> ('vec (processed like a list)) + (if (i32.eq $type (global.get $VECTOR_T)) (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "vec")) + (local.set $second ($qq_foldr $ast)) + (local.set $res ($LIST2 $sym $second)) + ($RELEASE $sym) + ($RELEASE $second) + (return $res))) + + ;; If ast is not affected by eval, return it unchanged. + (if (i32.ne $type (global.get $LIST_T)) (then + (return ($INC_REF $ast)))) + + ;; (unquote x) -> x + (local.set $second ($qq_unquote $ast "unquote")) + (if $second (then + (return ($INC_REF $second)))) + + ;; ast is a normal list, iterate on its elements + (return ($qq_foldr $ast))) + + ;; Helper for quasiquote. + ;; If the given list ast contains at least two elements and starts + ;; with the given symbol, return the second element. Else return 0. + (func $qq_unquote (param $ast i32) (param $sym i32) (result i32) + (LET $car 0 $cdr 0) + (if ($VAL0 $ast) (then + (local.set $car ($MEM_VAL1_ptr $ast)) + (if (i32.eq ($TYPE $car) (global.get $SYMBOL_T)) (then + (if (i32.eqz ($strcmp ($to_String $car) $sym)) (then + (local.set $cdr ($MEM_VAL0_ptr $ast)) + (if ($VAL0 $cdr) (then + (return ($MEM_VAL1_ptr $cdr)))))))))) + (return 0)) + + ;; Iteration on sequences for quasiquote (right reduce/fold). + (func $qq_foldr (param $xs i32) (result i32) + (if ($VAL0 $xs) (then + (return ($qq_loop ($MEM_VAL1_ptr $xs) ($qq_foldr ($MEM_VAL0_ptr $xs))))) + (else + (return ($INC_REF (global.get $EMPTY_LIST)))))) + + ;; Transition function for quasiquote right fold/reduce. + (func $qq_loop (param $elt i32) (param $acc i32) (result i32) + (LET $sym 0 $second 0 $res 0) + + ;; If elt is ('splice-unquote x) -> ('concat, x, acc) + (if (i32.eq ($TYPE $elt) (global.get $LIST_T)) (then + (local.set $second ($qq_unquote $elt "splice-unquote")) + (if $second (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "concat")) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $sym) + (return $res))))) + + ;; normal elt -> ('cons, (quasiquoted x), acc) + (local.set $sym ($STRING (global.get $SYMBOL_T) "cons")) + (local.set $second ($QUASIQUOTE $elt)) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $second) + ($RELEASE $sym) + (return $res)) + (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32) (LET $res 0 $val2 0 $val3 0 $type 0 $found 0 @@ -240,6 +270,10 @@ (then (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) (br $EVAL_return)) + (else (if (i32.eqz ($strcmp "quasiquoteexpand" $a0sym)) + (then + (local.set $res ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) + (br $EVAL_return)) (else (if (i32.eqz ($strcmp "quasiquote" $a0sym)) (then (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) @@ -336,7 +370,7 @@ ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0) ($RELEASE $f_args) - (br $EVAL_return))))))))))))))))))) + (br $EVAL_return))))))))))))))))))))) ) ;; end of TCO_loop ) ;; end of EVAL_return diff --git a/impls/wasm/step8_macros.wam b/impls/wasm/step8_macros.wam index 20f7059c..331e0d69 100644 --- a/impls/wasm/step8_macros.wam +++ b/impls/wasm/step8_macros.wam @@ -8,55 +8,85 @@ ) ;; EVAL - (func $is_pair (param $ast i32) (result i32) - (LET $type ($TYPE $ast)) - (AND (OR (i32.eq $type (global.get $LIST_T)) - (i32.eq $type (global.get $VECTOR_T))) - (i32.ne ($VAL0 $ast) 0)) - ) + (func $QUASIQUOTE (param $ast i32) (result i32) - (LET $res 0 $sym 0 $second 0 $third 0) - (if (i32.eqz ($is_pair $ast)) ;; QQ_QUOTE - (then - (local.set $sym ($STRING (global.get $SYMBOL_T) "quote")) - ;; ['quote ast] - (local.set $res ($LIST2 $sym $ast)) - ($RELEASE $sym)) - (else - (local.set $res ($MEM_VAL1_ptr $ast)) - (if (AND (i32.eq ($TYPE $res) (global.get $SYMBOL_T)) - (i32.eqz ($strcmp "unquote" ($to_String $res)))) - (then - ;; ast[1] - (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))))) - (else (if (AND ($is_pair $res) - (i32.eq ($TYPE ($MEM_VAL1_ptr $res)) - (global.get $SYMBOL_T)) - (i32.eqz ($strcmp "splice-unquote" - ($to_String ($MEM_VAL1_ptr $res))))) - (then - ;; ['concat, ast[0][1], quasiquote(ast[1..])] - (local.set $sym ($STRING (global.get $SYMBOL_T) "concat")) - (local.set $second - ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL1_ptr $ast)))) - (local.set $third ($QUASIQUOTE ($MEM_VAL0_ptr $ast))) - (local.set $res ($LIST3 $sym $second $third)) - ;; release inner quasiquoted since outer list take ownership - ($RELEASE $third) - ($RELEASE $sym)) - (else - ;; ['cons, quasiquote(ast[0]), quasiquote(ast[1..])] - (local.set $sym ($STRING (global.get $SYMBOL_T) "cons")) - (local.set $second ($QUASIQUOTE ($MEM_VAL1_ptr $ast))) - (local.set $third ($QUASIQUOTE ($MEM_VAL0_ptr $ast))) - (local.set $res ($LIST3 $sym $second $third)) - ;; release inner quasiquoted since outer list takes ownership - ($RELEASE $third) - ($RELEASE $second) - ($RELEASE $sym))))))) - $res - ) + (LET $type ($TYPE $ast) $res 0 $sym 0 $second 0) + + ;; symbol or map -> ('quote ast) + (if (OR (i32.eq $type (global.get $SYMBOL_T)) + (i32.eq $type (global.get $HASHMAP_T))) + (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "quote")) + (local.set $res ($LIST2 $sym $ast)) + ($RELEASE $sym) + (return $res))) + + ;; [xs..] -> ('vec (processed like a list)) + (if (i32.eq $type (global.get $VECTOR_T)) (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "vec")) + (local.set $second ($qq_foldr $ast)) + (local.set $res ($LIST2 $sym $second)) + ($RELEASE $sym) + ($RELEASE $second) + (return $res))) + + ;; If ast is not affected by eval, return it unchanged. + (if (i32.ne $type (global.get $LIST_T)) (then + (return ($INC_REF $ast)))) + + ;; (unquote x) -> x + (local.set $second ($qq_unquote $ast "unquote")) + (if $second (then + (return ($INC_REF $second)))) + + ;; ast is a normal list, iterate on its elements + (return ($qq_foldr $ast))) + + ;; Helper for quasiquote. + ;; If the given list ast contains at least two elements and starts + ;; with the given symbol, return the second element. Else return 0. + (func $qq_unquote (param $ast i32) (param $sym i32) (result i32) + (LET $car 0 $cdr 0) + (if ($VAL0 $ast) (then + (local.set $car ($MEM_VAL1_ptr $ast)) + (if (i32.eq ($TYPE $car) (global.get $SYMBOL_T)) (then + (if (i32.eqz ($strcmp ($to_String $car) $sym)) (then + (local.set $cdr ($MEM_VAL0_ptr $ast)) + (if ($VAL0 $cdr) (then + (return ($MEM_VAL1_ptr $cdr)))))))))) + (return 0)) + + ;; Iteration on sequences for quasiquote (right reduce/fold). + (func $qq_foldr (param $xs i32) (result i32) + (if ($VAL0 $xs) (then + (return ($qq_loop ($MEM_VAL1_ptr $xs) ($qq_foldr ($MEM_VAL0_ptr $xs))))) + (else + (return ($INC_REF (global.get $EMPTY_LIST)))))) + + ;; Transition function for quasiquote right fold/reduce. + (func $qq_loop (param $elt i32) (param $acc i32) (result i32) + (LET $sym 0 $second 0 $res 0) + + ;; If elt is ('splice-unquote x) -> ('concat, x, acc) + (if (i32.eq ($TYPE $elt) (global.get $LIST_T)) (then + (local.set $second ($qq_unquote $elt "splice-unquote")) + (if $second (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "concat")) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $sym) + (return $res))))) + + ;; normal elt -> ('cons, (quasiquoted x), acc) + (local.set $sym ($STRING (global.get $SYMBOL_T) "cons")) + (local.set $second ($QUASIQUOTE $elt)) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $second) + ($RELEASE $sym) + (return $res)) + (global $mac_stack (mut i32) (i32.const 0)) (global $mac_stack_top (mut i32) (i32.const -1)) @@ -292,6 +322,10 @@ (then (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) (br $EVAL_return)) + (else (if (i32.eqz ($strcmp "quasiquoteexpand" $a0sym)) + (then + (local.set $res ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) + (br $EVAL_return)) (else (if (i32.eqz ($strcmp "quasiquote" $a0sym)) (then (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) @@ -405,7 +439,7 @@ ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0) ($RELEASE $f_args) - (br $EVAL_return))))))))))))))))))))))) + (br $EVAL_return))))))))))))))))))))))))) ) ;; end of TCO_loop ) ;; end of EVAL_return diff --git a/impls/wasm/step9_try.wam b/impls/wasm/step9_try.wam index 11900603..01569353 100644 --- a/impls/wasm/step9_try.wam +++ b/impls/wasm/step9_try.wam @@ -8,55 +8,85 @@ ) ;; EVAL - (func $is_pair (param $ast i32) (result i32) - (LET $type ($TYPE $ast)) - (AND (OR (i32.eq $type (global.get $LIST_T)) - (i32.eq $type (global.get $VECTOR_T))) - (i32.ne ($VAL0 $ast) 0)) - ) + (func $QUASIQUOTE (param $ast i32) (result i32) - (LET $res 0 $sym 0 $second 0 $third 0) - (if (i32.eqz ($is_pair $ast)) ;; QQ_QUOTE - (then - (local.set $sym ($STRING (global.get $SYMBOL_T) "quote")) - ;; ['quote ast] - (local.set $res ($LIST2 $sym $ast)) - ($RELEASE $sym)) - (else - (local.set $res ($MEM_VAL1_ptr $ast)) - (if (AND (i32.eq ($TYPE $res) (global.get $SYMBOL_T)) - (i32.eqz ($strcmp "unquote" ($to_String $res)))) - (then - ;; ast[1] - (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))))) - (else (if (AND ($is_pair $res) - (i32.eq ($TYPE ($MEM_VAL1_ptr $res)) - (global.get $SYMBOL_T)) - (i32.eqz ($strcmp "splice-unquote" - ($to_String ($MEM_VAL1_ptr $res))))) - (then - ;; ['concat, ast[0][1], quasiquote(ast[1..])] - (local.set $sym ($STRING (global.get $SYMBOL_T) "concat")) - (local.set $second - ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL1_ptr $ast)))) - (local.set $third ($QUASIQUOTE ($MEM_VAL0_ptr $ast))) - (local.set $res ($LIST3 $sym $second $third)) - ;; release inner quasiquoted since outer list take ownership - ($RELEASE $third) - ($RELEASE $sym)) - (else - ;; ['cons, quasiquote(ast[0]), quasiquote(ast[1..])] - (local.set $sym ($STRING (global.get $SYMBOL_T) "cons")) - (local.set $second ($QUASIQUOTE ($MEM_VAL1_ptr $ast))) - (local.set $third ($QUASIQUOTE ($MEM_VAL0_ptr $ast))) - (local.set $res ($LIST3 $sym $second $third)) - ;; release inner quasiquoted since outer list takes ownership - ($RELEASE $third) - ($RELEASE $second) - ($RELEASE $sym))))))) - $res - ) + (LET $type ($TYPE $ast) $res 0 $sym 0 $second 0) + + ;; symbol or map -> ('quote ast) + (if (OR (i32.eq $type (global.get $SYMBOL_T)) + (i32.eq $type (global.get $HASHMAP_T))) + (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "quote")) + (local.set $res ($LIST2 $sym $ast)) + ($RELEASE $sym) + (return $res))) + + ;; [xs..] -> ('vec (processed like a list)) + (if (i32.eq $type (global.get $VECTOR_T)) (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "vec")) + (local.set $second ($qq_foldr $ast)) + (local.set $res ($LIST2 $sym $second)) + ($RELEASE $sym) + ($RELEASE $second) + (return $res))) + + ;; If ast is not affected by eval, return it unchanged. + (if (i32.ne $type (global.get $LIST_T)) (then + (return ($INC_REF $ast)))) + + ;; (unquote x) -> x + (local.set $second ($qq_unquote $ast "unquote")) + (if $second (then + (return ($INC_REF $second)))) + + ;; ast is a normal list, iterate on its elements + (return ($qq_foldr $ast))) + + ;; Helper for quasiquote. + ;; If the given list ast contains at least two elements and starts + ;; with the given symbol, return the second element. Else return 0. + (func $qq_unquote (param $ast i32) (param $sym i32) (result i32) + (LET $car 0 $cdr 0) + (if ($VAL0 $ast) (then + (local.set $car ($MEM_VAL1_ptr $ast)) + (if (i32.eq ($TYPE $car) (global.get $SYMBOL_T)) (then + (if (i32.eqz ($strcmp ($to_String $car) $sym)) (then + (local.set $cdr ($MEM_VAL0_ptr $ast)) + (if ($VAL0 $cdr) (then + (return ($MEM_VAL1_ptr $cdr)))))))))) + (return 0)) + + ;; Iteration on sequences for quasiquote (right reduce/fold). + (func $qq_foldr (param $xs i32) (result i32) + (if ($VAL0 $xs) (then + (return ($qq_loop ($MEM_VAL1_ptr $xs) ($qq_foldr ($MEM_VAL0_ptr $xs))))) + (else + (return ($INC_REF (global.get $EMPTY_LIST)))))) + + ;; Transition function for quasiquote right fold/reduce. + (func $qq_loop (param $elt i32) (param $acc i32) (result i32) + (LET $sym 0 $second 0 $res 0) + + ;; If elt is ('splice-unquote x) -> ('concat, x, acc) + (if (i32.eq ($TYPE $elt) (global.get $LIST_T)) (then + (local.set $second ($qq_unquote $elt "splice-unquote")) + (if $second (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "concat")) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $sym) + (return $res))))) + + ;; normal elt -> ('cons, (quasiquoted x), acc) + (local.set $sym ($STRING (global.get $SYMBOL_T) "cons")) + (local.set $second ($QUASIQUOTE $elt)) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $second) + ($RELEASE $sym) + (return $res)) + (global $mac_stack (mut i32) (i32.const 0)) (global $mac_stack_top (mut i32) (i32.const -1)) @@ -293,6 +323,10 @@ (then (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) (br $EVAL_return)) + (else (if (i32.eqz ($strcmp "quasiquoteexpand" $a0sym)) + (then + (local.set $res ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) + (br $EVAL_return)) (else (if (i32.eqz ($strcmp "quasiquote" $a0sym)) (then (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) @@ -452,7 +486,7 @@ ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0) ($RELEASE $f_args) - (br $EVAL_return))))))))))))))))))))))))) + (br $EVAL_return))))))))))))))))))))))))))) ) ;; end of TCO_loop ) ;; end of EVAL_return diff --git a/impls/wasm/stepA_mal.wam b/impls/wasm/stepA_mal.wam index a8866a2a..1bb0d86d 100644 --- a/impls/wasm/stepA_mal.wam +++ b/impls/wasm/stepA_mal.wam @@ -8,55 +8,85 @@ ) ;; EVAL - (func $is_pair (param $ast i32) (result i32) - (LET $type ($TYPE $ast)) - (AND (OR (i32.eq $type (global.get $LIST_T)) - (i32.eq $type (global.get $VECTOR_T))) - (i32.ne ($VAL0 $ast) 0)) - ) + (func $QUASIQUOTE (param $ast i32) (result i32) - (LET $res 0 $sym 0 $second 0 $third 0) - (if (i32.eqz ($is_pair $ast)) ;; QQ_QUOTE - (then - (local.set $sym ($STRING (global.get $SYMBOL_T) "quote")) - ;; ['quote ast] - (local.set $res ($LIST2 $sym $ast)) - ($RELEASE $sym)) - (else - (local.set $res ($MEM_VAL1_ptr $ast)) - (if (AND (i32.eq ($TYPE $res) (global.get $SYMBOL_T)) - (i32.eqz ($strcmp "unquote" ($to_String $res)))) - (then - ;; ast[1] - (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))))) - (else (if (AND ($is_pair $res) - (i32.eq ($TYPE ($MEM_VAL1_ptr $res)) - (global.get $SYMBOL_T)) - (i32.eqz ($strcmp "splice-unquote" - ($to_String ($MEM_VAL1_ptr $res))))) - (then - ;; ['concat, ast[0][1], quasiquote(ast[1..])] - (local.set $sym ($STRING (global.get $SYMBOL_T) "concat")) - (local.set $second - ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL1_ptr $ast)))) - (local.set $third ($QUASIQUOTE ($MEM_VAL0_ptr $ast))) - (local.set $res ($LIST3 $sym $second $third)) - ;; release inner quasiquoted since outer list take ownership - ($RELEASE $third) - ($RELEASE $sym)) - (else - ;; ['cons, quasiquote(ast[0]), quasiquote(ast[1..])] - (local.set $sym ($STRING (global.get $SYMBOL_T) "cons")) - (local.set $second ($QUASIQUOTE ($MEM_VAL1_ptr $ast))) - (local.set $third ($QUASIQUOTE ($MEM_VAL0_ptr $ast))) - (local.set $res ($LIST3 $sym $second $third)) - ;; release inner quasiquoted since outer list takes ownership - ($RELEASE $third) - ($RELEASE $second) - ($RELEASE $sym))))))) - $res - ) + (LET $type ($TYPE $ast) $res 0 $sym 0 $second 0) + + ;; symbol or map -> ('quote ast) + (if (OR (i32.eq $type (global.get $SYMBOL_T)) + (i32.eq $type (global.get $HASHMAP_T))) + (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "quote")) + (local.set $res ($LIST2 $sym $ast)) + ($RELEASE $sym) + (return $res))) + + ;; [xs..] -> ('vec (processed like a list)) + (if (i32.eq $type (global.get $VECTOR_T)) (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "vec")) + (local.set $second ($qq_foldr $ast)) + (local.set $res ($LIST2 $sym $second)) + ($RELEASE $sym) + ($RELEASE $second) + (return $res))) + + ;; If ast is not affected by eval, return it unchanged. + (if (i32.ne $type (global.get $LIST_T)) (then + (return ($INC_REF $ast)))) + + ;; (unquote x) -> x + (local.set $second ($qq_unquote $ast "unquote")) + (if $second (then + (return ($INC_REF $second)))) + + ;; ast is a normal list, iterate on its elements + (return ($qq_foldr $ast))) + + ;; Helper for quasiquote. + ;; If the given list ast contains at least two elements and starts + ;; with the given symbol, return the second element. Else return 0. + (func $qq_unquote (param $ast i32) (param $sym i32) (result i32) + (LET $car 0 $cdr 0) + (if ($VAL0 $ast) (then + (local.set $car ($MEM_VAL1_ptr $ast)) + (if (i32.eq ($TYPE $car) (global.get $SYMBOL_T)) (then + (if (i32.eqz ($strcmp ($to_String $car) $sym)) (then + (local.set $cdr ($MEM_VAL0_ptr $ast)) + (if ($VAL0 $cdr) (then + (return ($MEM_VAL1_ptr $cdr)))))))))) + (return 0)) + + ;; Iteration on sequences for quasiquote (right reduce/fold). + (func $qq_foldr (param $xs i32) (result i32) + (if ($VAL0 $xs) (then + (return ($qq_loop ($MEM_VAL1_ptr $xs) ($qq_foldr ($MEM_VAL0_ptr $xs))))) + (else + (return ($INC_REF (global.get $EMPTY_LIST)))))) + + ;; Transition function for quasiquote right fold/reduce. + (func $qq_loop (param $elt i32) (param $acc i32) (result i32) + (LET $sym 0 $second 0 $res 0) + + ;; If elt is ('splice-unquote x) -> ('concat, x, acc) + (if (i32.eq ($TYPE $elt) (global.get $LIST_T)) (then + (local.set $second ($qq_unquote $elt "splice-unquote")) + (if $second (then + (local.set $sym ($STRING (global.get $SYMBOL_T) "concat")) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $sym) + (return $res))))) + + ;; normal elt -> ('cons, (quasiquoted x), acc) + (local.set $sym ($STRING (global.get $SYMBOL_T) "cons")) + (local.set $second ($QUASIQUOTE $elt)) + (local.set $res ($LIST3 $sym $second $acc)) + ;; release inner quasiquoted since outer list takes ownership + ($RELEASE $second) + ($RELEASE $sym) + (return $res)) + (global $mac_stack (mut i32) (i32.const 0)) (global $mac_stack_top (mut i32) (i32.const -1)) @@ -293,6 +323,10 @@ (then (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) (br $EVAL_return)) + (else (if (i32.eqz ($strcmp "quasiquoteexpand" $a0sym)) + (then + (local.set $res ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) + (br $EVAL_return)) (else (if (i32.eqz ($strcmp "quasiquote" $a0sym)) (then (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) @@ -452,7 +486,7 @@ ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0) ($RELEASE $f_args) - (br $EVAL_return))))))))))))))))))))))))) + (br $EVAL_return))))))))))))))))))))))))))) ) ;; end of TCO_loop ) ;; end of EVAL_return diff --git a/impls/wren/core.wren b/impls/wren/core.wren index 346bf27a..5a681ac4 100644 --- a/impls/wren/core.wren +++ b/impls/wren/core.wren @@ -67,6 +67,7 @@ class Core { "sequential?": fn { |a| a[0] is MalSequential }, "cons": fn { |a| MalList.new([a[0]] + a[1].elements) }, "concat": fn { |a| MalList.new(a.reduce([]) { |acc,e| acc + e.elements }) }, + "vec": fn { |a| MalVector.new(a[0].elements) }, "nth": fn { |a| a[1] < a[0].count ? a[0][a[1]] : Fiber.abort("nth: index out of range") }, "first": fn { |a| a[0] == null ? null : a[0].first }, "rest": fn { |a| a[0] == null ? MalList.new([]) : a[0].rest }, diff --git a/impls/wren/step7_quote.wren b/impls/wren/step7_quote.wren index bf37950f..985c18cc 100644 --- a/impls/wren/step7_quote.wren +++ b/impls/wren/step7_quote.wren @@ -11,17 +11,37 @@ class Mal { return MalReader.read_str(str) } - static isPair(x) { x is MalSequential && !x.isEmpty } + static qq_loop(elt, acc) { + if (elt is MalList && elt.count == 2 && elt[0] is MalSymbol && elt[0].value == "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), elt[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } + } + + static qq_foldr(ast) { + var acc = MalList.new([]) + var i = ast.count - 1 + while (0 <= i) { + acc = qq_loop(ast[i], acc) + i = i - 1 + } + return acc + } static quasiquote(ast) { - if (!isPair(ast)) { + if (ast is MalList) { + if (ast.count == 2 && ast[0] is MalSymbol && ast[0].value == "unquote") { + return ast[1] + } else { + return qq_foldr(ast) + } + } else if (ast is MalVector) { + return MalList.new([MalSymbol.new("vec"), qq_foldr(ast)]) + } else if (ast is MalSymbol || ast is MalMap) { return MalList.new([MalSymbol.new("quote"), ast]) - } else if (ast[0] is MalSymbol && ast[0].value == "unquote") { - return ast[1] - } else if (isPair(ast[0]) && ast[0][0] is MalSymbol && ast[0][0].value == "splice-unquote") { - return MalList.new([MalSymbol.new("concat"), ast[0][1], quasiquote(ast.rest)]) } else { - return MalList.new([MalSymbol.new("cons"), quasiquote(ast[0]), quasiquote(ast.rest)]) + return ast } } @@ -63,6 +83,8 @@ class Mal { tco = true } else if (ast[0].value == "quote") { return ast[1] + } else if (ast[0].value == "quasiquoteexpand") { + return quasiquote(ast[1]) } else if (ast[0].value == "quasiquote") { ast = quasiquote(ast[1]) tco = true diff --git a/impls/wren/step8_macros.wren b/impls/wren/step8_macros.wren index 659ad4b9..f45ed967 100644 --- a/impls/wren/step8_macros.wren +++ b/impls/wren/step8_macros.wren @@ -11,17 +11,37 @@ class Mal { return MalReader.read_str(str) } - static isPair(x) { x is MalSequential && !x.isEmpty } + static qq_loop(elt, acc) { + if (elt is MalList && elt.count == 2 && elt[0] is MalSymbol && elt[0].value == "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), elt[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } + } + + static qq_foldr(ast) { + var acc = MalList.new([]) + var i = ast.count - 1 + while (0 <= i) { + acc = qq_loop(ast[i], acc) + i = i - 1 + } + return acc + } static quasiquote(ast) { - if (!isPair(ast)) { + if (ast is MalList) { + if (ast.count == 2 && ast[0] is MalSymbol && ast[0].value == "unquote") { + return ast[1] + } else { + return qq_foldr(ast) + } + } else if (ast is MalVector) { + return MalList.new([MalSymbol.new("vec"), qq_foldr(ast)]) + } else if (ast is MalSymbol || ast is MalMap) { return MalList.new([MalSymbol.new("quote"), ast]) - } else if (ast[0] is MalSymbol && ast[0].value == "unquote") { - return ast[1] - } else if (isPair(ast[0]) && ast[0][0] is MalSymbol && ast[0][0].value == "splice-unquote") { - return MalList.new([MalSymbol.new("concat"), ast[0][1], quasiquote(ast.rest)]) } else { - return MalList.new([MalSymbol.new("cons"), quasiquote(ast[0]), quasiquote(ast.rest)]) + return ast } } @@ -82,6 +102,8 @@ class Mal { tco = true } else if (ast[0].value == "quote") { return ast[1] + } else if (ast[0].value == "quasiquoteexpand") { + return quasiquote(ast[1]) } else if (ast[0].value == "quasiquote") { ast = quasiquote(ast[1]) tco = true diff --git a/impls/wren/step9_try.wren b/impls/wren/step9_try.wren index 0d75379e..d891cb36 100644 --- a/impls/wren/step9_try.wren +++ b/impls/wren/step9_try.wren @@ -11,17 +11,37 @@ class Mal { return MalReader.read_str(str) } - static isPair(x) { x is MalSequential && !x.isEmpty } + static qq_loop(elt, acc) { + if (elt is MalList && elt.count == 2 && elt[0] is MalSymbol && elt[0].value == "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), elt[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } + } + + static qq_foldr(ast) { + var acc = MalList.new([]) + var i = ast.count - 1 + while (0 <= i) { + acc = qq_loop(ast[i], acc) + i = i - 1 + } + return acc + } static quasiquote(ast) { - if (!isPair(ast)) { + if (ast is MalList) { + if (ast.count == 2 && ast[0] is MalSymbol && ast[0].value == "unquote") { + return ast[1] + } else { + return qq_foldr(ast) + } + } else if (ast is MalVector) { + return MalList.new([MalSymbol.new("vec"), qq_foldr(ast)]) + } else if (ast is MalSymbol || ast is MalMap) { return MalList.new([MalSymbol.new("quote"), ast]) - } else if (ast[0] is MalSymbol && ast[0].value == "unquote") { - return ast[1] - } else if (isPair(ast[0]) && ast[0][0] is MalSymbol && ast[0][0].value == "splice-unquote") { - return MalList.new([MalSymbol.new("concat"), ast[0][1], quasiquote(ast.rest)]) } else { - return MalList.new([MalSymbol.new("cons"), quasiquote(ast[0]), quasiquote(ast.rest)]) + return ast } } @@ -82,6 +102,8 @@ class Mal { tco = true } else if (ast[0].value == "quote") { return ast[1] + } else if (ast[0].value == "quasiquoteexpand") { + return quasiquote(ast[1]) } else if (ast[0].value == "quasiquote") { ast = quasiquote(ast[1]) tco = true diff --git a/impls/wren/stepA_mal.wren b/impls/wren/stepA_mal.wren index 19a2aff2..aa2f1305 100644 --- a/impls/wren/stepA_mal.wren +++ b/impls/wren/stepA_mal.wren @@ -11,17 +11,37 @@ class Mal { return MalReader.read_str(str) } - static isPair(x) { x is MalSequential && !x.isEmpty } + static qq_loop(elt, acc) { + if (elt is MalList && elt.count == 2 && elt[0] is MalSymbol && elt[0].value == "splice-unquote") { + return MalList.new([MalSymbol.new("concat"), elt[1], acc]) + } else { + return MalList.new([MalSymbol.new("cons"), quasiquote(elt), acc]) + } + } + + static qq_foldr(ast) { + var acc = MalList.new([]) + var i = ast.count - 1 + while (0 <= i) { + acc = qq_loop(ast[i], acc) + i = i - 1 + } + return acc + } static quasiquote(ast) { - if (!isPair(ast)) { + if (ast is MalList) { + if (ast.count == 2 && ast[0] is MalSymbol && ast[0].value == "unquote") { + return ast[1] + } else { + return qq_foldr(ast) + } + } else if (ast is MalVector) { + return MalList.new([MalSymbol.new("vec"), qq_foldr(ast)]) + } else if (ast is MalSymbol || ast is MalMap) { return MalList.new([MalSymbol.new("quote"), ast]) - } else if (ast[0] is MalSymbol && ast[0].value == "unquote") { - return ast[1] - } else if (isPair(ast[0]) && ast[0][0] is MalSymbol && ast[0][0].value == "splice-unquote") { - return MalList.new([MalSymbol.new("concat"), ast[0][1], quasiquote(ast.rest)]) } else { - return MalList.new([MalSymbol.new("cons"), quasiquote(ast[0]), quasiquote(ast.rest)]) + return ast } } @@ -82,6 +102,8 @@ class Mal { tco = true } else if (ast[0].value == "quote") { return ast[1] + } else if (ast[0].value == "quasiquoteexpand") { + return quasiquote(ast[1]) } else if (ast[0].value == "quasiquote") { ast = quasiquote(ast[1]) tco = true diff --git a/impls/xslt/core.xslt b/impls/xslt/core.xslt index 012e1ed8..9615db99 100644 --- a/impls/xslt/core.xslt +++ b/impls/xslt/core.xslt @@ -88,6 +88,9 @@ false + + false + false @@ -390,6 +393,13 @@ + + + + + + + diff --git a/impls/xslt/step7_quote.inc.xslt b/impls/xslt/step7_quote.inc.xslt index 23630fd1..33938af0 100644 --- a/impls/xslt/step7_quote.inc.xslt +++ b/impls/xslt/step7_quote.inc.xslt @@ -182,71 +182,96 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + - + + + + + + + + + + + + + + @@ -491,6 +516,19 @@ + + + + + + + + + + + @@ -765,8 +803,4 @@ - - - - diff --git a/impls/xslt/step8_macros.inc.xslt b/impls/xslt/step8_macros.inc.xslt index bb7c3b47..9bd63953 100644 --- a/impls/xslt/step8_macros.inc.xslt +++ b/impls/xslt/step8_macros.inc.xslt @@ -182,71 +182,96 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + - + + + + + + + + + + + + + + @@ -589,6 +614,19 @@ + + + + + + + + + + + @@ -879,11 +917,6 @@ - - - - diff --git a/impls/xslt/step9_try.inc.xslt b/impls/xslt/step9_try.inc.xslt index aecf9d86..9ce8dff5 100644 --- a/impls/xslt/step9_try.inc.xslt +++ b/impls/xslt/step9_try.inc.xslt @@ -221,71 +221,96 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + - + + + + + + + + + + + + + + @@ -628,6 +653,19 @@ + + + + + + + + + + + @@ -1051,10 +1089,6 @@ - - - - diff --git a/impls/xslt/stepA_mal.inc.xslt b/impls/xslt/stepA_mal.inc.xslt index af3d05d7..bb54b497 100644 --- a/impls/xslt/stepA_mal.inc.xslt +++ b/impls/xslt/stepA_mal.inc.xslt @@ -431,71 +431,96 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + - + + + + + + + + + + + + + + @@ -843,6 +868,19 @@ EVALUATE IN ( + + + + + + + + + + + @@ -1069,10 +1107,6 @@ EVALUATED () - - - diff --git a/impls/yorick/core.i b/impls/yorick/core.i index 3b499c26..bd3d2464 100644 --- a/impls/yorick/core.i +++ b/impls/yorick/core.i @@ -151,6 +151,16 @@ func mal_concat(a) return MalList(val=&seq) } +func mal_vec(a) +{ + if (numberof(a) == 1) { + type = structof(*a(1)) + if (type == MalVector) return *(a(1)) + if (type == MalList) return MalVector(val=a(1)->val) + } + return MalError(message="vec: requires a sequence") +} + func mal_nth(a) { index = a(2)->val @@ -344,6 +354,7 @@ h_set, core_ns, "vals", mal_vals h_set, core_ns, "sequential?", mal_sequential_q h_set, core_ns, "cons", mal_cons h_set, core_ns, "concat", mal_concat +h_set, core_ns, "vec", mal_vec h_set, core_ns, "nth", mal_nth h_set, core_ns, "first", mal_first h_set, core_ns, "rest", mal_rest diff --git a/impls/yorick/step7_quote.i b/impls/yorick/step7_quote.i index 3d8d1aa9..67ebb627 100644 --- a/impls/yorick/step7_quote.i +++ b/impls/yorick/step7_quote.i @@ -9,25 +9,42 @@ func READ(str) return read_str(str) } -func is_pair(ast) +func starts_with(seq, sym) { - type = structof(ast) - return ((type == MalList) || (type == MalVector)) && count(ast) > 0 + return numberof(seq) == 2 && structof(*seq(1)) == MalSymbol && seq(1)->val == sym +} + +func quasiquote_loop(seq) +{ + acc = MalList(val=&[]) + for (i=numberof(seq); 0 0 + return numberof(seq) == 2 && structof(*seq(1)) == MalSymbol && seq(1)->val == sym +} + +func quasiquote_loop(seq) +{ + acc = MalList(val=&[]) + for (i=numberof(seq); 0 0 + return numberof(seq) == 2 && structof(*seq(1)) == MalSymbol && seq(1)->val == sym +} + +func quasiquote_loop(seq) +{ + acc = MalList(val=&[]) + for (i=numberof(seq); 0 0 + return numberof(seq) == 2 && structof(*seq(1)) == MalSymbol && seq(1)->val == sym +} + +func quasiquote_loop(seq) +{ + acc = MalList(val=&[]) + for (i=numberof(seq); 0 |l| l, + .Vector => |v| v, + else => return MalError.TypeError, + }; + const copy = try linked_list.deepcopy(Allocator, ll); + return MalType.new_vector(Allocator, copy); +} + pub fn cons(a1: *const MalType, a2: *const MalType) MalError!*MalType { // TODO: do we need this for vectors? const old_ll = try a2.const_sequence_linked_list(); @@ -807,6 +817,7 @@ pub const core_namespace = [_] CorePair { CorePair { .name = "deref", .func = CorePairData {.Fn1 = &deref} }, CorePair { .name = "reset!", .func = CorePairData {.Fn2 = &atom_reset} }, CorePair { .name = "swap!", .func = CorePairData {.FVar = &atom_swap} }, + CorePair { .name = "vec", .func = CorePairData {.Fn1 = &vec} }, CorePair { .name = "cons", .func = CorePairData {.Fn2 = &cons} }, CorePair { .name = "concat", .func = CorePairData {.FVar = &concat} }, CorePair { .name = "rest", .func = CorePairData {.Fn1 = &rest } }, diff --git a/impls/zig/step7_quote.zig b/impls/zig/step7_quote.zig index adbcd4c8..0b26ed25 100644 --- a/impls/zig/step7_quote.zig +++ b/impls/zig/step7_quote.zig @@ -66,6 +66,13 @@ fn EVAL(mal_arg: *MalType, env_arg: *Env) MalError!*MalType { else if(string_eql(symbol, "quote")) { return EVAL_quote(mal, env); } + else if(string_eql(symbol, "quasiquoteexpand")) { + env.delete(); + (try mal.sequence_pop_first(Allocator)).delete(Allocator); + var second = try mal.sequence_pop_first(Allocator); + mal.delete(Allocator); + return try quasiquote(second); + } else if(string_eql(symbol, "quasiquote")) { (try mal.sequence_pop_first(Allocator)).delete(Allocator); var second = try mal.sequence_pop_first(Allocator); @@ -98,13 +105,19 @@ fn eval(a1: *MalType) MalError!*MalType { return EVAL(try a1.copy(Allocator), try repl_environment.copy(Allocator)); } -fn is_pair(mal: *MalType) ?*MalType { - const ll = switch(mal.data) { +fn starts_with(ast: *MalType, sym: []const u8) bool { + const ll = switch(ast.data) { .List => |l| l, - .Vector => |v| v, - else => return null, + else => return false, }; - return linked_list.first(&ll); + if(ll.count() < 2) { + return false; + } + const ss = switch(ll.at(0).data) { + .Generic => |s| s, + else => return false, + }; + return string_eql(ss, sym); } fn EVAL_def(mal: *MalType, env: *Env) MalError!*MalType { @@ -216,51 +229,50 @@ fn EVAL_quote(mal: *MalType, env: *Env) MalError!*MalType { return try mal.sequence_pop_first(Allocator); } -fn quasiquote(mal: *MalType) MalError!*MalType { - var optional_mal = is_pair(mal); - if(optional_mal == null) { +fn quasiquote(ast: *MalType) MalError!*MalType { + const kind = MalTypeValue(ast.data); + if(kind == MalTypeValue.Generic or kind == MalTypeValue.HashMap) { const new_list = try MalType.new_list_empty(Allocator); try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "quote")); - try new_list.sequence_append(Allocator, mal); + try new_list.sequence_append(Allocator, ast); return new_list; } - var ast_first = optional_mal.?; - switch(ast_first.data) { - .Generic => |s| { - if(string_eql(s, "unquote")) { - (try mal.sequence_pop_first(Allocator)).delete(Allocator); - const second_mal = try mal.sequence_pop_first(Allocator); - defer mal.delete(Allocator); - return second_mal; - } - }, - else => {}, + if(kind != MalTypeValue.List and kind != MalTypeValue.Vector) { + return ast; } - optional_mal = is_pair(ast_first); - if(optional_mal) |first_first| { - const s = switch(first_first.data) { - .Generic => |s| s, - else => "", - }; - if(string_eql(s, "splice-unquote")) { - const new_list = try MalType.new_list_empty(Allocator); + defer ast.delete(Allocator); + + if(starts_with(ast, "unquote")) { + (try ast.sequence_pop_first(Allocator)).delete(Allocator); + return ast.sequence_pop_first(Allocator); + } + + var result = try MalType.new_list_empty(Allocator); + while(0 < (try ast.sequence_length())) { + var elt = try ast.sequence_pop_last(Allocator); + const new_list = try MalType.new_list_empty(Allocator); + if(starts_with(elt, "splice-unquote")) { + (try elt.sequence_pop_first(Allocator)).delete(Allocator); + defer elt.delete(Allocator); try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "concat")); - const first_second = try ast_first.sequence_nth(1); - try new_list.sequence_append(Allocator, try first_second.copy(Allocator)); - (try mal.sequence_pop_first(Allocator)).delete(Allocator); - try new_list.sequence_append(Allocator, try quasiquote(mal)); - return new_list; + try new_list.sequence_append(Allocator, try elt.sequence_pop_first(Allocator)); + } else { + try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "cons")); + try new_list.sequence_append(Allocator, try quasiquote(elt)); } + try new_list.sequence_append(Allocator, result); + result = new_list; } - const new_list = try MalType.new_list_empty(Allocator); - try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "cons")); - _ = try mal.sequence_pop_first(Allocator); - try new_list.sequence_append(Allocator, try quasiquote(ast_first)); - try new_list.sequence_append(Allocator, try quasiquote(mal)); - return new_list; + if(kind == MalTypeValue.Vector) { + const new_list = try MalType.new_list_empty(Allocator); + try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "vec")); + try new_list.sequence_append(Allocator, result); + result = new_list; + } + return result; } fn PRINT(optional_mal: ?*MalType) MalError![] u8 { diff --git a/impls/zig/step8_macros.zig b/impls/zig/step8_macros.zig index 34b3da57..4559db7d 100644 --- a/impls/zig/step8_macros.zig +++ b/impls/zig/step8_macros.zig @@ -70,6 +70,13 @@ fn EVAL(mal_arg: *MalType, env_arg: *Env) MalError!*MalType { else if(string_eql(symbol, "quote")) { return EVAL_quote(mal, env); } + else if(string_eql(symbol, "quasiquoteexpand")) { + env.delete(); + (try mal.sequence_pop_first(Allocator)).delete(Allocator); + var second = try mal.sequence_pop_first(Allocator); + mal.delete(Allocator); + return try quasiquote(second); + } else if(string_eql(symbol, "quasiquote")) { (try mal.sequence_pop_first(Allocator)).delete(Allocator); var second = try mal.sequence_pop_first(Allocator); @@ -109,13 +116,19 @@ fn eval(a1: *MalType) MalError!*MalType { return EVAL(try a1.copy(Allocator), try repl_environment.copy(Allocator)); } -fn is_pair(mal: *MalType) ?*MalType { - const ll = switch(mal.data) { +fn starts_with(ast: *MalType, sym: []const u8) bool { + const ll = switch(ast.data) { .List => |l| l, - .Vector => |v| v, - else => return null, + else => return false, }; - return linked_list.first(&ll); + if(ll.count() < 2) { + return false; + } + const ss = switch(ll.at(0).data) { + .Generic => |s| s, + else => return false, + }; + return string_eql(ss, sym); } fn is_macro_call(mal: *MalType, env: *Env) ?*MalType { @@ -276,51 +289,50 @@ fn EVAL_quote(mal: *MalType, env: *Env) MalError!*MalType { return try mal.sequence_pop_first(Allocator); } -fn quasiquote(mal: *MalType) MalError!*MalType { - var optional_mal = is_pair(mal); - if(optional_mal == null) { +fn quasiquote(ast: *MalType) MalError!*MalType { + const kind = MalTypeValue(ast.data); + if(kind == MalTypeValue.Generic or kind == MalTypeValue.HashMap) { const new_list = try MalType.new_list_empty(Allocator); try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "quote")); - try new_list.sequence_append(Allocator, mal); + try new_list.sequence_append(Allocator, ast); return new_list; } - var ast_first = optional_mal.?; - switch(ast_first.data) { - .Generic => |s| { - if(string_eql(s, "unquote")) { - (try mal.sequence_pop_first(Allocator)).delete(Allocator); - const second_mal = try mal.sequence_pop_first(Allocator); - defer mal.delete(Allocator); - return second_mal; - } - }, - else => {}, + if(kind != MalTypeValue.List and kind != MalTypeValue.Vector) { + return ast; } - optional_mal = is_pair(ast_first); - if(optional_mal) |first_first| { - const s = switch(first_first.data) { - .Generic => |s| s, - else => "", - }; - if(string_eql(s, "splice-unquote")) { - const new_list = try MalType.new_list_empty(Allocator); + defer ast.delete(Allocator); + + if(starts_with(ast, "unquote")) { + (try ast.sequence_pop_first(Allocator)).delete(Allocator); + return ast.sequence_pop_first(Allocator); + } + + var result = try MalType.new_list_empty(Allocator); + while(0 < (try ast.sequence_length())) { + var elt = try ast.sequence_pop_last(Allocator); + const new_list = try MalType.new_list_empty(Allocator); + if(starts_with(elt, "splice-unquote")) { + (try elt.sequence_pop_first(Allocator)).delete(Allocator); + defer elt.delete(Allocator); try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "concat")); - const first_second = try ast_first.sequence_nth(1); - try new_list.sequence_append(Allocator, try first_second.copy(Allocator)); - (try mal.sequence_pop_first(Allocator)).delete(Allocator); - try new_list.sequence_append(Allocator, try quasiquote(mal)); - return new_list; + try new_list.sequence_append(Allocator, try elt.sequence_pop_first(Allocator)); + } else { + try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "cons")); + try new_list.sequence_append(Allocator, try quasiquote(elt)); } + try new_list.sequence_append(Allocator, result); + result = new_list; } - const new_list = try MalType.new_list_empty(Allocator); - try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "cons")); - _ = try mal.sequence_pop_first(Allocator); - try new_list.sequence_append(Allocator, try quasiquote(ast_first)); - try new_list.sequence_append(Allocator, try quasiquote(mal)); - return new_list; + if(kind == MalTypeValue.Vector) { + const new_list = try MalType.new_list_empty(Allocator); + try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "vec")); + try new_list.sequence_append(Allocator, result); + result = new_list; + } + return result; } fn PRINT(optional_mal: ?*MalType) MalError![] u8 { diff --git a/impls/zig/step9_try.zig b/impls/zig/step9_try.zig index f9fd75ee..d5614657 100644 --- a/impls/zig/step9_try.zig +++ b/impls/zig/step9_try.zig @@ -73,6 +73,13 @@ fn EVAL(mal_arg: *MalType, env_arg: *Env) MalError!*MalType { else if(string_eql(symbol, "quote")) { return EVAL_quote(mal, env); } + else if(string_eql(symbol, "quasiquoteexpand")) { + env.delete(); + (try mal.sequence_pop_first(Allocator)).delete(Allocator); + var second = try mal.sequence_pop_first(Allocator); + mal.delete(Allocator); + return try quasiquote(second); + } else if(string_eql(symbol, "quasiquote")) { (try mal.sequence_pop_first(Allocator)).delete(Allocator); var second = try mal.sequence_pop_first(Allocator); @@ -115,13 +122,19 @@ fn eval(a1: *MalType) MalError!*MalType { return EVAL(try a1.copy(Allocator), try repl_environment.copy(Allocator)); } -fn is_pair(mal: *MalType) ?*MalType { - const ll = switch(mal.data) { +fn starts_with(ast: *MalType, sym: []const u8) bool { + const ll = switch(ast.data) { .List => |l| l, - .Vector => |v| v, - else => return null, + else => return false, }; - return linked_list.first(&ll); + if(ll.count() < 2) { + return false; + } + const ss = switch(ll.at(0).data) { + .Generic => |s| s, + else => return false, + }; + return string_eql(ss, sym); } fn is_macro_call(mal: *MalType, env: *Env) ?*MalType { @@ -319,51 +332,50 @@ fn EVAL_try(mal: *MalType, env: *Env) MalError!*MalType { return evaled_mal; } -fn quasiquote(mal: *MalType) MalError!*MalType { - var optional_mal = is_pair(mal); - if(optional_mal == null) { +fn quasiquote(ast: *MalType) MalError!*MalType { + const kind = MalTypeValue(ast.data); + if(kind == MalTypeValue.Generic or kind == MalTypeValue.HashMap) { const new_list = try MalType.new_list_empty(Allocator); try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "quote")); - try new_list.sequence_append(Allocator, mal); + try new_list.sequence_append(Allocator, ast); return new_list; } - var ast_first = optional_mal.?; - switch(ast_first.data) { - .Generic => |s| { - if(string_eql(s, "unquote")) { - (try mal.sequence_pop_first(Allocator)).delete(Allocator); - const second_mal = try mal.sequence_pop_first(Allocator); - defer mal.delete(Allocator); - return second_mal; - } - }, - else => {}, + if(kind != MalTypeValue.List and kind != MalTypeValue.Vector) { + return ast; } - optional_mal = is_pair(ast_first); - if(optional_mal) |first_first| { - const s = switch(first_first.data) { - .Generic => |s| s, - else => "", - }; - if(string_eql(s, "splice-unquote")) { - const new_list = try MalType.new_list_empty(Allocator); + defer ast.delete(Allocator); + + if(starts_with(ast, "unquote")) { + (try ast.sequence_pop_first(Allocator)).delete(Allocator); + return ast.sequence_pop_first(Allocator); + } + + var result = try MalType.new_list_empty(Allocator); + while(0 < (try ast.sequence_length())) { + var elt = try ast.sequence_pop_last(Allocator); + const new_list = try MalType.new_list_empty(Allocator); + if(starts_with(elt, "splice-unquote")) { + (try elt.sequence_pop_first(Allocator)).delete(Allocator); + defer elt.delete(Allocator); try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "concat")); - const first_second = try ast_first.sequence_nth(1); - try new_list.sequence_append(Allocator, try first_second.copy(Allocator)); - (try mal.sequence_pop_first(Allocator)).delete(Allocator); - try new_list.sequence_append(Allocator, try quasiquote(mal)); - return new_list; + try new_list.sequence_append(Allocator, try elt.sequence_pop_first(Allocator)); + } else { + try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "cons")); + try new_list.sequence_append(Allocator, try quasiquote(elt)); } + try new_list.sequence_append(Allocator, result); + result = new_list; } - const new_list = try MalType.new_list_empty(Allocator); - try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "cons")); - _ = try mal.sequence_pop_first(Allocator); - try new_list.sequence_append(Allocator, try quasiquote(ast_first)); - try new_list.sequence_append(Allocator, try quasiquote(mal)); - return new_list; + if(kind == MalTypeValue.Vector) { + const new_list = try MalType.new_list_empty(Allocator); + try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "vec")); + try new_list.sequence_append(Allocator, result); + result = new_list; + } + return result; } fn PRINT(optional_mal: ?*MalType) MalError![] u8 { diff --git a/impls/zig/stepA_mal.zig b/impls/zig/stepA_mal.zig index 5340850e..ff8e74fd 100644 --- a/impls/zig/stepA_mal.zig +++ b/impls/zig/stepA_mal.zig @@ -73,6 +73,13 @@ fn EVAL(mal_arg: *MalType, env_arg: *Env) MalError!*MalType { else if(string_eql(symbol, "quote")) { return EVAL_quote(mal, env); } + else if(string_eql(symbol, "quasiquoteexpand")) { + env.delete(); + (try mal.sequence_pop_first(Allocator)).delete(Allocator); + var second = try mal.sequence_pop_first(Allocator); + mal.delete(Allocator); + return try quasiquote(second); + } else if(string_eql(symbol, "quasiquote")) { (try mal.sequence_pop_first(Allocator)).delete(Allocator); var second = try mal.sequence_pop_first(Allocator); @@ -115,13 +122,19 @@ fn eval(a1: *MalType) MalError!*MalType { return EVAL(try a1.copy(Allocator), try repl_environment.copy(Allocator)); } -fn is_pair(mal: *MalType) ?*MalType { - const ll = switch(mal.data) { +fn starts_with(ast: *MalType, sym: []const u8) bool { + const ll = switch(ast.data) { .List => |l| l, - .Vector => |v| v, - else => return null, + else => return false, }; - return linked_list.first(&ll); + if(ll.count() < 2) { + return false; + } + const ss = switch(ll.at(0).data) { + .Generic => |s| s, + else => return false, + }; + return string_eql(ss, sym); } fn is_macro_call(mal: *MalType, env: *Env) ?*MalType { @@ -319,51 +332,50 @@ fn EVAL_try(mal: *MalType, env: *Env) MalError!*MalType { return evaled_mal; } -fn quasiquote(mal: *MalType) MalError!*MalType { - var optional_mal = is_pair(mal); - if(optional_mal == null) { +fn quasiquote(ast: *MalType) MalError!*MalType { + const kind = MalTypeValue(ast.data); + if(kind == MalTypeValue.Generic or kind == MalTypeValue.HashMap) { const new_list = try MalType.new_list_empty(Allocator); try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "quote")); - try new_list.sequence_append(Allocator, mal); + try new_list.sequence_append(Allocator, ast); return new_list; } - var ast_first = optional_mal.?; - switch(ast_first.data) { - .Generic => |s| { - if(string_eql(s, "unquote")) { - (try mal.sequence_pop_first(Allocator)).delete(Allocator); - const second_mal = try mal.sequence_pop_first(Allocator); - defer mal.delete(Allocator); - return second_mal; - } - }, - else => {}, + if(kind != MalTypeValue.List and kind != MalTypeValue.Vector) { + return ast; } - optional_mal = is_pair(ast_first); - if(optional_mal) |first_first| { - const s = switch(first_first.data) { - .Generic => |s| s, - else => "", - }; - if(string_eql(s, "splice-unquote")) { - const new_list = try MalType.new_list_empty(Allocator); + defer ast.delete(Allocator); + + if(starts_with(ast, "unquote")) { + (try ast.sequence_pop_first(Allocator)).delete(Allocator); + return ast.sequence_pop_first(Allocator); + } + + var result = try MalType.new_list_empty(Allocator); + while(0 < (try ast.sequence_length())) { + var elt = try ast.sequence_pop_last(Allocator); + const new_list = try MalType.new_list_empty(Allocator); + if(starts_with(elt, "splice-unquote")) { + (try elt.sequence_pop_first(Allocator)).delete(Allocator); + defer elt.delete(Allocator); try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "concat")); - const first_second = try ast_first.sequence_nth(1); - try new_list.sequence_append(Allocator, try first_second.copy(Allocator)); - (try mal.sequence_pop_first(Allocator)).delete(Allocator); - try new_list.sequence_append(Allocator, try quasiquote(mal)); - return new_list; + try new_list.sequence_append(Allocator, try elt.sequence_pop_first(Allocator)); + } else { + try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "cons")); + try new_list.sequence_append(Allocator, try quasiquote(elt)); } + try new_list.sequence_append(Allocator, result); + result = new_list; } - const new_list = try MalType.new_list_empty(Allocator); - try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "cons")); - _ = try mal.sequence_pop_first(Allocator); - try new_list.sequence_append(Allocator, try quasiquote(ast_first)); - try new_list.sequence_append(Allocator, try quasiquote(mal)); - return new_list; + if(kind == MalTypeValue.Vector) { + const new_list = try MalType.new_list_empty(Allocator); + try new_list.sequence_append(Allocator, try MalType.new_generic(Allocator, "vec")); + try new_list.sequence_append(Allocator, result); + result = new_list; + } + return result; } fn PRINT(optional_mal: ?*MalType) MalError![] u8 { diff --git a/process/guide.md b/process/guide.md index c12ab483..a0b2c542 100644 --- a/process/guide.md +++ b/process/guide.md @@ -1123,9 +1123,10 @@ unquoted (normal evaluation). There are two special forms that only mean something within a quasiquoted list: `unquote` and `splice-unquote`. These are perhaps best explained with some examples: -* `(def! lst (quote (2 3)))` -> `(2 3)` -* `(quasiquote (1 (unquote lst)))` -> `(1 (2 3))` -* `(quasiquote (1 (splice-unquote lst)))` -> `(1 2 3)` +* `(def! lst (quote (b c)))` -> `(b c)` +* `(quasiquote (a lst d)` -> `(a lst d)` +* `(quasiquote (a (unquote lst) d)` -> `(a (b c) d)` +* `(quasiquote (a (splice-unquote lst)) d)` -> `(a b c d)` The `unquote` form turns evaluation back on for its argument and the result of evaluation is put in place into the quasiquoted list. The @@ -1162,28 +1163,57 @@ Mal borrows most of its syntax and feature-set). * Add the `quote` special form. This form just returns its argument (the second list element of `ast`). -* Add the `quasiquote` special form. First implement a helper function - `is_pair` that returns true if the parameter is a non-empty list. - Then define a `quasiquote` function. This is called from `EVAL` with - the first `ast` argument (second list element) and then `ast` is set - to the result and execution continues at the top of the loop (TCO). +* Add the `quasiquote` function. The `quasiquote` function takes a parameter `ast` and has the - following conditional: - 1. if `is_pair` of `ast` is false: return a new list containing: - a symbol named "quote" and `ast`. - 2. else if the first element of `ast` is a symbol named "unquote": - return the second element of `ast`. - 3. if `is_pair` of the first element of `ast` is true and the first - element of first element of `ast` (`ast[0][0]`) is a symbol named - "splice-unquote": return a new list containing: a symbol named - "concat", the second element of first element of `ast` - (`ast[0][1]`), and the result of calling `quasiquote` with the - second through last element of `ast`. - 4. otherwise: return a new list containing: a symbol named "cons", the - result of calling `quasiquote` on first element of `ast` - (`ast[0]`), and the result of calling `quasiquote` with the second - through last element of `ast`. + 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 + list populated by the following process. + The result is initially an empty list. + Iterate over each element `elt` of `ast` in reverse order: + - If `elt` is a list starting with the "splice-unquote" symbol, + replace the current result with a list containing: + the "concat" symbol, + the second element of `elt`, + then the previous result. + - Else replace the current result with a list containing: + the "cons" symbol, + the result of calling `quasiquote` with `elt` as argument, + then the previous result. + + This process can also be described recursively: + - If `ast` is empty return it unchanged. else let `elt` be its + first element. + - If `elt` is a list starting with the "splice-unquote" symbol, + return a list containing: + the "concat" symbol, + the second element of `elt`, + then the result of processing the rest of `ast`. + - Else return a list containing: + the "cons" symbol, + the result of calling `quasiquote` with `elt` as argument, + then the result of processing the rest of `ast`. + - If `ast` is a map or a symbol, return a list containing: + the "quote" symbol, + then `ast`. + - Else return `ast` unchanged. + Such forms are not affected by evaluation, so you may quote them + as in the previous case if implementation is easyer. + +* Optionally, add a the `quasiquoteexpand` special form. + This form calls the `quasiquote` function using the first `ast` + argument (second list element) and returns the result. + It has no other practical purpose than testing your implementation + of the `quasiquote` internal function. + +* Add the `quasiquote` special form. + This form does the same than `quasiquoteexpand`, + but evaluates the result in the current environment before returning it, + either by recursively calling `EVAL` with the result and `env`, + or by assigning `ast` with the result and continuing execution at + the top of the loop (TCO). Now go to the top level, run the step 7 tests: ``` @@ -1218,12 +1248,20 @@ macros. the symbol "splice-unquote" and the result of reading the next form (`read_form`). -* Add support for quoting of vectors. The `is_pair` function should - return true if the argument is a non-empty list or vector. `cons` +* Add support for quoting of vectors. `cons` should also accept a vector as the second argument. The return value - is a list regardless. `concat` should support concatenation of - lists, vectors, or a mix or both. The result is always a list. + is a list regardless. `concat` should support concatenation of + lists, vectors, or a mix of both. The result is always a list. + Implement a core function `vec` turning a list into a vector with + the same elements. If provided a vector, `vec` should return it + unchanged. + + In the `quasiquote` function, when `ast` is a vector, + return a list containing: + the "vec" symbol, + then the result of processing `ast` as if it were a list not + starting with `quote`. diff --git a/process/step7_quote.txt b/process/step7_quote.txt index 55039272..6ccfb94d 100644 --- a/process/step7_quote.txt +++ b/process/step7_quote.txt @@ -3,7 +3,6 @@ import types, reader, printer, env, core READ(str): return reader.read_str(str) -pair?(ast): return ... // true if non-empty sequence quasiquote(ast): return ... // quasiquote eval_ast(ast,env): @@ -83,6 +82,7 @@ ns = {'=: equal?, 'cons: (a) -> concat([a[0]], a[1]), 'concat: (a) -> reduce(concat, [], a), + 'vec: (l) -> l converted to vector, 'empty?: empty?, 'count: count, diff --git a/process/step8_macros.txt b/process/step8_macros.txt index 1bb37033..42a5dc56 100644 --- a/process/step8_macros.txt +++ b/process/step8_macros.txt @@ -3,7 +3,6 @@ import types, reader, printer, env, core READ(str): return reader.read_str(str) -pair?(ast): return ... // true if non-empty sequence quasiquote(ast): return ... // quasiquote macro?(ast, env): return ... // true if macro call @@ -93,6 +92,7 @@ ns = {'=: equal?, 'cons: (a) -> concat([a[0]], a[1]), 'concat: (a) -> reduce(concat, [], a), + 'vec: (l) -> l converted to vector, 'nth: (a) -> a[0][a[1]] OR raise "nth: index out of range", 'first: (a) -> a[0][0] OR nil, 'rest: (a) -> a[0][1..] OR list(), diff --git a/process/step9_try.txt b/process/step9_try.txt index 092f89ce..a5988c43 100644 --- a/process/step9_try.txt +++ b/process/step9_try.txt @@ -3,7 +3,6 @@ import types, reader, printer, env, core READ(str): return reader.read_str(str) -pair?(ast): return ... // true if non-empty sequence quasiquote(ast): return ... // quasiquote macro?(ast, env): return ... // true if macro call @@ -114,6 +113,7 @@ ns = {'=: equal?, 'sequential? sequential?, 'cons: (a) -> concat([a[0]], a[1]), 'concat: (a) -> reduce(concat, [], a), + 'vec: (l) -> l converted to vector, 'nth: (a) -> a[0][a[1]] OR raise "nth: index out of range", 'first: (a) -> a[0][0] OR nil, 'rest: (a) -> a[0][1..] OR list(), diff --git a/process/stepA_mal.txt b/process/stepA_mal.txt index 76669c86..1f3ac412 100644 --- a/process/stepA_mal.txt +++ b/process/stepA_mal.txt @@ -3,7 +3,6 @@ import types, reader, printer, env, core READ(str): return reader.read_str(str) -pair?(ast): return ... // true if non-empty sequence quasiquote(ast): return ... // quasiquote macro?(ast, env): return ... // true if macro call @@ -122,6 +121,7 @@ ns = {'=: equal?, 'sequential? sequential?, 'cons: (a) -> concat([a[0]], a[1]), 'concat: (a) -> reduce(concat, [], a), + 'vec: (l) -> l converted to vector, 'nth: (a) -> a[0][a[1]] OR raise "nth: index out of range", 'first: (a) -> a[0][0] OR nil, 'rest: (a) -> a[0][1..] OR list(),